Popupmenu の Ownerdraw







Popup Menu の背景色を  $00FFB3B3 に変えてみます

(MainMenu でも同じだと思います)

プロパティ OwnerDraw を True に

MenuItem イベントの OnDrawItem と OnMeasureItem を

コーディングします



//通常のメニュー

procedure TForm1.Help1DrawItem(Sender: TObject; ACanvas: TCanvas;

  ARect: TRect; Selected: Boolean);

begin

    ACanvas.Brush.Color := $00FFB3B3;//色の設定

    ACanvas.FillRect (ARect);

   // テキスト領域 左の余白

    Arect.Left := 15;

    DrawText(ACanvas.Handle, PChar(TMenuItem(Sender).Caption),

             -1, ARect, DT_SINGLELINE or DT_VCENTER);

end;



procedure TForm1.Help1MeasureItem(Sender: TObject; ACanvas: TCanvas;

  var Width, Height: Integer);

begin

  Width := 60;

  Height := 25;

end;



//チェックのあるメニューアイテム

procedure TForm1.sec1DrawItem(Sender: TObject; ACanvas: TCanvas;

  ARect: TRect; Selected: Boolean);

begin

    ACanvas.Brush.Color := $00FFB3B3;//色の設定

    ACanvas.FillRect (ARect);

     //チェックされた場合 矩形を描く

	if Sec1.Checked then

  	begin

   	 ACanvas.Rectangle (ARect.Left+2, ARect.Top+8,

   	 ARect.Right-67, ARect.Bottom-8);

   	end;

   // テキスト領域

     Arect.Left := 15;

     DrawText(ACanvas.Handle, PChar(TMenuItem(Sender).Caption),

             -1, ARect, DT_SINGLELINE or DT_VCENTER)

end;



procedure TForm1.sec1MeasureItem(Sender: TObject; ACanvas: TCanvas;

  var Width, Height: Integer);

begin

  Width := 60;

  Height := 25;

end;



//セパレーター 背景と ラインの影とハイライト

procedure TForm1.N1DrawItem(Sender: TObject; ACanvas: TCanvas;

  ARect: TRect; Selected: Boolean);

begin

      ACanvas.Brush.Color := $00FFB3B3;//背景色

      ACanvas.FillRect (ARect);

    with ACanvas do begin

      Pen.Color := clGrayText;//ライン 影の色

      MoveTo(ARect.Left + 1, ARect.Top +

              (ARect.Bottom - ARect.Top) div 2);

      LineTo(ARect.Right - 1, ARect.Top +

              (ARect.Bottom - ARect.Top) div 2);

      Pen.Color :=  clBtnHighlight;//ライン ハイライト

      MoveTo(ARect.Left + 1, ARect.Top +

              (ARect.Bottom - ARect.Top) div 2 +1);

      LineTo(ARect.Right - 1, ARect.Top +

              (ARect.Bottom - ARect.Top) div 2 +1);

    end;

end;



procedure TForm1.N1MeasureItem(Sender: TObject; ACanvas: TCanvas;

  var Width, Height: Integer);

begin

   Width := 60;

  Height := 10;

end;












Back