xpmenu.pas

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

                  if Enable then
                     begin
                        for x := 0 to TToolBar(Comp).ButtonCount - 1 do
                           if (not assigned(TToolBar(Comp).OnCustomDrawButton))
                              or (FOverrideOwnerDraw) then
                              begin
                                 TToolBar(Comp).OnCustomDrawButton :=
                                    ToolBarDrawButton;

                              end;
                     end
                  else
                     begin
                        if addr(TToolBar(Comp).OnCustomDrawButton) =
                           addr(TXPMenu.ToolBarDrawButton) then
                           TToolBar(Comp).OnCustomDrawButton := nil;
                     end;
                  if Update then
                     TToolBar(Comp).Invalidate;
               end;
         {$ENDIF}

         if (Comp is TControlBar) and (xcControlBar in FXPControls) then
            if not (csDesigning in ComponentState) then
               begin
                  if Enable then
                     begin
                        if (not assigned(TControlBar(Comp).OnBandPaint))
                           or (FOverrideOwnerDraw) then
                           begin
                              TControlBar(Comp).OnBandPaint := ControlBarPaint;
                           end;
                     end
                  else
                     begin
                        if addr(TControlBar(Comp).OnBandPaint) =
                           addr(TXPMenu.ControlBarPaint) then
                           TControlBar(Comp).OnBandPaint := nil;
                     end;
                  if Update then
                     TControlBar(Comp).Invalidate;
               end;

         if not (csDesigning in ComponentState) then
            if ((Comp is TSpeedButton) and (xcSpeedButton in FXPControls)) then
               if ((TControl(Comp).Parent is TToolbar) and (xccToolBar in FXPContainers)) or
                  ((TControl(Comp).Parent is TCoolbar) and (xccCoolbar in FXPContainers)) or
                  ((TControl(Comp).Parent is TCustomForm) and (xccForm in FXPContainers)) then
                  begin
                     if (Enable) and (Comp.Tag <> 999) and (TControl(Comp).Parent.Tag <> 999) then
                        {skip if Control/Control.parent.tag = 999}
                        with TControlSubClass.Create(Self) do
                           begin
                              Control := TControl(Comp);
                              if Addr(Control.WindowProc) <> Addr(TControlSubClass.ControlSubClass) then
                                 begin
                                    orgWindowProc := Control.WindowProc;
                                    Control.WindowProc := ControlSubClass;
                                 end;
                              XPMenu := self;
                           end;

                     if Update then
                        begin
                           // if Comp is TWinControl then    //Cause error with non wincontrol
                           TControl(Comp).invalidate //in TControlSubClass.ControlSubClass
                           // else
                           //   TControl(Comp).Update;
                        end;

                  end;

         // Recursive call for possible containers.
         {$IFDEF VER5U}
         if ((Comp is TCustomFrame) and (xccFrame in FXPContainers))
            or (Comp is TCustomForm) then //By Geir Wikran <[e-mail]>
            self.InitItems(Comp as TWinControl, Enable, Update);
         {$ENDIF}

      end;
end;

procedure TXPMenu.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
   Selected: Boolean);
begin
   if FActive then
      MenueDrawItem(Sender, ACanvas, ARect, Selected);
end;

function TXPMenu.GetImageExtent(MenuItem: TMenuItem): TPoint;
var
   HasImgLstBitmap: boolean;
   B: TBitmap;
   FTopMenu: boolean;
begin
   FTopMenu := false;
   B := TBitmap.Create;
   B.Width := 0;
   B.Height := 0;
   Result.x := 0;
   Result.Y := 0;
   HasImgLstBitmap := false;

   {Changes MMK TForm and TFrame}
   if (FForm is TForm) and ((FForm as TForm).Menu <> nil) then
      if MenuItem.GetParentComponent.Name = (FForm as TForm).Menu.Name then
         begin
            FTopMenu := true;
            if (FForm as TForm).Menu.Images <> nil then
               if MenuItem.ImageIndex <> -1 then
                  HasImgLstBitmap := true;

         end;

   {End Changes}

   if (MenuItem.Parent.GetParentMenu.Images <> nil)
      {$IFDEF VER5U}
   or (MenuItem.Parent.SubMenuImages <> nil)
      {$ENDIF} then
      begin
         if MenuItem.ImageIndex <> -1 then
            HasImgLstBitmap := true
         else
            HasImgLstBitmap := false;
      end;

   if HasImgLstBitmap then
      begin
         {$IFDEF VER5U}
         if MenuItem.Parent.SubMenuImages <> nil then
            MenuItem.Parent.SubMenuImages.GetBitmap(MenuItem.ImageIndex, B)
         else
            {$ENDIF}
            MenuItem.Parent.GetParentMenu.Images.GetBitmap(MenuItem.ImageIndex, B)
      end
   else
      if MenuItem.Bitmap.Width > 0 then
      B.Assign(TBitmap(MenuItem.Bitmap));

   Result.x := B.Width;
   Result.Y := B.Height;

   if not FTopMenu then
      if Result.x < FIconWidth then
         Result.x := FIconWidth;

   B.Free;
end;

procedure TXPMenu.MeasureItem(Sender: TObject; ACanvas: TCanvas;
   var Width, Height: Integer);
var
   s: string;
   W, H: integer;
   P: TPoint;
   IsLine: boolean;
   OSVersionInfo: TOSVersionInfo;
begin
   if FActive then
      begin
         S := TMenuItem(Sender).Caption;

         if S = '-' then
            IsLine := true
         else
            IsLine := false;
         if IsLine then
            S := '';

         if Trim(ShortCutToText(TMenuItem(Sender).ShortCut)) <> '' then
            S := S + ShortCutToText(TMenuItem(Sender).ShortCut) + 'WWW';

         ACanvas.Font.Assign(FFont);
         W := ACanvas.TextWidth(s);
         Inc(W, 5);
         if pos('&', s) > 0 then
            W := W - ACanvas.TextWidth('&');

         P := GetImageExtent(TMenuItem(Sender));
         if P.X > 0 then
            W := W + P.x;

         //Add 8 pixels for win2k
         if (FForm is TForm) and ((FForm as TForm).Menu <> nil) then
            if TMenuItem(Sender).GetParentComponent.Name = (FForm as TForm).Menu.Name then
               begin //FTopMenu := true;
                  GetVersionEx(OSVersionInfo);
                  if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
                     Inc(W, 8);
               end;

         if Width < W then
            Width := W;

         if IsLine then
            Height := 4
         else
            begin
               H := ACanvas.TextHeight(s) + Round(ACanvas.TextHeight(s) * 0.75);
               if P.y + 6 > H then
                  H := P.y + 6;

               if Height < H then
                  Height := H;
            end;
      end;

end;

procedure TXPMenu.MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
   Selected: Boolean);
var
   txt: string;
   B: TBitmap;
   IconRect, TextRect, CheckedRect: TRect;
   i, X1, X2: integer;
   TextFormat: integer;
   HasImgLstBitmap: boolean;
   HasBitmap: boolean;
   FMenuItem: TMenuItem;
   FMenu: TMenu;
   FTopMenu: boolean;
   IsLine: boolean;
   ImgListHandle: HImageList; {Commctrl.pas}
   ImgIndex: integer;
   hWndM: HWND;
   hDcM: HDC;

begin

   FTopMenu := false;
   FMenuItem := TMenuItem(Sender);

   SetGlobalColor(ACanvas);

   if FMenuItem.Caption = '-' then
      IsLine := true
   else
      IsLine := false;

   FMenu := FMenuItem.Parent.GetParentMenu;

   if FMenu is TMainMenu then
      for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
         if FMenuItem.GetParentMenu.Items[i] = FMenuItem then
            begin
               FTopMenu := True;
               break;
            end;

   ACanvas.Font.Assign(FFont);

   Inc(ARect.Bottom, 1);
   TextRect := ARect;
   txt := ' ' + FMenuItem.Caption;

   B := TBitmap.Create;
   HasBitmap := false;
   HasImgLstBitmap := false;

   if (FMenuItem.Parent.GetParentMenu.Images <> nil)
      {$IFDEF VER5U}
   or (FMenuItem.Parent.SubMenuImages <> nil)
      {$ENDIF} then
      begin
         if FMenuItem.ImageIndex <> -1 then
            HasImgLstBitmap := true
         else
            HasImgLstBitmap := false;
      end;

   if FMenuItem.Bitmap.Width > 0 then
      HasBitmap := true;

   //-------
   if HasBitmap then
      begin
         B.Width := FMenuItem.Bitmap.Width;
         B.Height := FMenuItem.Bitmap.Height;
         B.Canvas.Draw(0, 0, FMenuItem.Bitmap);
         {
         B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), FMenuItem.Bitmap.Canvas,
            Rect(0, 0, B.Width, B.Height));
         }
      end;

   if HasImgLstBitmap then
      begin
         {$IFDEF VER5U}
         if FMenuItem.Parent.SubMenuImages <> nil then
            begin
               ImgListHandle := FMenuItem.Parent.SubMenuImages.Handle;
               ImgIndex := FMenuItem.ImageIndex;

               B.Width := FMenuItem.Parent.SubMenuImages.Width;
               B.Height := FMenuItem.Parent.SubMenuImages.Height;
               {
               B.Canvas.Brush.Color := ACanvas.Brush.Color;
               B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
               ImageList_DrawEx(ImgListHandle, ImgIndex,
                  B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
               }
               ImageList_DrawEx(ImgListHandle, ImgIndex,
                  B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_NORMAL);
            end
         else
            {$ENDIF}
            if FMenuItem.Parent.GetParentMenu.Images <> nil then
            begin
               ImgListHandle := FMenuItem.Parent.GetParentMenu.Images.Handle;
               ImgIndex := FMenuItem.ImageIndex;

               B.Width := FMenuItem.Parent.GetParentMenu.Images.Width;
               B.Height := FMenuItem.Parent.GetParentMenu.Images.Height;
               {
               B.Canvas.Brush.Color := ACanvas.Pixels[2, 2];
               B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
               ImageList_DrawEx(ImgListHandle, ImgIndex,
                  B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
               }
               ImageList_DrawEx(ImgListHandle, ImgIndex,
                  B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_NORMAL);
            end;
      end;

   //-----

   if FMenu.IsRightToLeft then
      begin
         X1 := ARect.Right - FIconWidth;
         X2 := ARect.Right;
      end
   else
      begin
         X1 := ARect.Left;
         X2 := ARect.Left + FIconWidth;
      end;
   IconRect := Rect(X1, ARect.Top, X2, ARect.Bottom);

   if HasImgLstBitmap or HasBitmap then
      begin
         CheckedRect := IconRect;
         Inc(CheckedRect.Left, 1);
         Inc(CheckedRect.Top, 2);
         Dec(CheckedRect.Right, 3);
         Dec(CheckedRect.Bottom, 2);
      end
   else
      begin
         CheckedRect.Left := IconRect.Left +
            (IConRect.Right - IconRect.Left - 10) div 2;
         CheckedRect.Top := IconRect.Top +
            (IConRect.Bottom - IconRect.Top - 10) div 2;
         CheckedRect.Right := CheckedRect.Left + 10;
         CheckedRect.Bottom := CheckedRect.Top + 10;
      end;

   if B.Width > FIconWidth then
      if FMenu.IsRightToLeft then
         CheckedRect.Left := CheckedRect.Right - B.Width
      else
         CheckedRect.Right := CheckedRect.Left + B.Width;

   if FTopMenu then Dec(CheckedRect.Top, 1);

   if FMenu.IsRightToLeft then
      begin
         X1 := ARect.Left;
         if not FTopMenu then
            Dec(X2, FIconWidth)
         else
            Dec(X2, 4);
         if (ARect.Right - B.Width) < X2 then
            X2 := ARect.Right - B.Width - 8;
      end
   else
      begin
         X1 := ARect.Left;
         if not FTopMenu then
            Inc(X1, FIconWidth)
         else
            Inc(X1, 4);

         if (ARect.Left + B.Width) > X1 then
            X1 := ARect.Left + B.Width + 4;
         X2 := ARect.Right;
      end;

   TextRect := Rect(X1, ARect.Top, X2, ARect.Bottom);

   if FTopMenu then
      begin
         if not (HasImgLstBitmap or HasBitmap) then
            begin
               TextRect := ARect;
            end
         else
            begin
               if FMenu.IsRightToLeft then
                  TextRect.Right := TextRect.Right + 5
               else
                  TextRect.Left := TextRect.Left - 5;
            end

      end;