Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Меню состоящее из одних изображений? [D7, Win95/98, WinXP]


Страницы:   1 2

killer ©   (2004-06-20 13:42:00) 

Подскажите пожалуйста... Как сделать меню состоящее из одних изображений? Как это сделано в ICQ или в Messanger-е при выборе смайлика...

killer   (2004-06-22 20:26:00) [1]

???

killer   (2004-06-21 23:04:00) [2]

sergeЗаменить только вылеленные тобой строки или все? Т.е. я как понял надо так сделать?

if (Sender as TMenuItem).Checked and Selected then begin
ACanvas.Brush.Color := clBtnHighlight;
ACanvas.FillRect(ARect);
DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);
DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
end else if Selected then begin
Rectangle(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
Rectangle(ACanvas.Handle, ARect, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
end else if (Sender as TMenuItem).Checked  then begin
DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);
DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
end;

но Rectangle там X1 Y1 X2 Y2...

serge   (2004-06-21 15:27:00) [3]


if (Sender as TMenuItem).Checked and Selected then begin
ACanvas.Brush.Color := clBtnHighlight;
ACanvas.FillRect(ARect);
DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);
DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
end else if Selected then begin
DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDOUTER, BF_BOTTOMRIGHT)

;
end else if (Sender as TMenuItem).Checked  then begin
DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);
DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
end;


Вместо DrawEdge пиши Rectangle();
а перед этим
[
pen.width:=...;
pen.color:=...;
brush.style:=bsclear
] - если надо будет.

killer   (2004-06-21 14:18:00) [4]

Клас!!! Спасибо тебе serge! Работает...:) Тут у меня еще один вопросик возник... можно ли какнибудь сделать чтобы при наведении на картинку, картинка квадратиком черным обводилась... как это осуществить?

Knight   (2004-06-21 13:00:00) [5]


> [22] GrayFace ©   (21.06.04 10:32)
> 1) Зачем TPaintBox? Лучше на канвасе формы.(Ведь все-равно
> нужна дополнительная форма)


Если меню не выходит за пределы формы то можно обойтись и без дополнительной...

serge   (2004-06-21 10:46:00) [6]

> GrayFace ©   (21.06.04 10:32) [22]
Григорьев Антон © очень даже прав ! :)

>killer ©
Нашел у себя давно скачанный компонент лови его текст:ъ

//
// TImageMenu 1.0
//   special for My Notes Center project
//     written by Dmitry "Creator" Bobrik / BC soft Team
//       (c) 2001
//         FREEWARE
//
unit ImageMenu;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Menus;

type
 TImageMenuSelectEvent = procedure (Sender: TObject; SelImage: integer) of object;

 TImageMenu = class(TPopupMenu)
 private
   { Private declarations }
  FCreated : boolean;
  FSelImage : integer;
  FOnSelect : TImageMenuSelectEvent;
  FImagesPerCol : integer;
  procedure MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
  procedure DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
 protected
   { Protected declarations }
  procedure DoPopup(Sender: TObject); override;
  procedure ClickImage(Sender: TObject);
 public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
   { Public declarations }
 published
   { Published declarations }
  property OnSelect : TImageMenuSelectEvent read FOnSelect write FOnSelect;
  property SelImage : integer read FSelImage write FSelImage;
  property ImagesPerCol : integer read FImagesPerCol write FImagesPerCol;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Samples', [TImageMenu]);
end;

constructor TImageMenu.Create(AOwner: TComponent);
begin
inherited;
Self.OwnerDraw := TRUE;
FCreated := FALSE;
end;

procedure TImageMenu.DoPopup(Sender: TObject);
var i : integer;
   M : TMenuItem;
begin
if not FCreated then begin
 if FImagesPerCol 0) then M.Break := mbBreak;
  M.RadioItem := TRUE;
  Self.Items.Add(M);
 end;
 FCreated := TRUE;
end;
Self.Items[FSelImage].Checked := TRUE;
inherited;
end;

destructor TImageMenu.Destroy;
begin
inherited;
end;

procedure TImageMenu.ClickImage(Sender: TObject);
begin
(Sender as TMenuItem).Checked := TRUE;
FSelImage := (Sender as TMenuItem).MenuIndex;
if Assigned(FOnSelect) then FOnSelect(Sender, FSelImage);
end;

procedure TImagemenu.MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height:
Integer);
begin
Height := 21;
Width := 6;
inherited;
end;

procedure TImageMenu.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected:
Boolean);
begin
ACanvas.Brush.Color := clMenu;
ACanvas.FillRect(ARect);
if (Sender as TMenuItem).Checked and Selected then begin
 ACanvas.Brush.Color := clBtnHighlight;
 ACanvas.FillRect(ARect);
 DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);
 DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
end else if Selected then begin
 DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
 DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
end else if (Sender as TMenuItem).Checked  then begin
 DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);
 DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
end;
Images.Draw(ACanvas, ARect.Left + 2, ARect.Top + 2, (Sender as TMenuItem).MenuIndex);
end;

end.

GrayFace   (2004-06-21 10:32:00) [7]

Knight
1) Зачем TPaintBox? Лучше на канвасе формы.(Ведь все-равно нужна дополнительная форма)
5) OnMouseClick
Григорьев Антон
Ему нужна таблица картинок, а не список.

Григорьев Антон   (2004-06-21 10:16:00) [8]

Да вы что тут все, про WM_DRAWITEM и WM_MEASUREITEM никогда не слышали? Какие-то PaintBox'ы, OnMouseMove... Бр!!! У TMenuItem есть события OnDrawItem и OnMeasureItem - с их помощью можно вместо текста на пункте меню отобразить всё, что угодно.

Knight   (2004-06-20 23:51:00) [9]


> [16] killer ©   (20.06.04 23:31)
> Knight Я почитал про TPaintBox, понял что в нем рисовать
> можно.... а вот как меню это сделать я не понимаю...

1) Бросаешь TPaintBox
2) Обзываешь его, например, SmilesMenuBox
3) onPaint - отрисовка изображений пунктов меню в цикле, например из TImageList, ресурса или ещё от куда...
4) onMouseMove - обработка перемещения мышы, например для подсветки...
5) onMouseDown - берёшь номер иконки и прячешь меню.

Можно также обработать события с клавы... вроде проще некуда.

pasha_golub   (2004-06-20 23:45:00) [10]

killer ©   (20.06.04 23:39) [18]
TControl.Width + TControl.Height + цикл

killer   (2004-06-20 23:39:00) [11]

pasha_golubа как это сделать?

pasha_golub   (2004-06-20 23:38:00) [12]

killer ©   (20.06.04 23:23) [14]
Это не самое сложное

killer   (2004-06-20 23:31:00) [13]

KnightЯ почитал про TPaintBox, понял что в нем рисовать можно.... а вот как меню это сделать я не понимаю...

Knight   (2004-06-20 23:27:00) [14]


> killer ©   (20.06.04 23:21)
> все изображения разные

По размеру или содержанию?
Если содержанию, то TPaintBox самый простой...

killer   (2004-06-20 23:23:00) [15]

pasha_golubхорошая идея кстати... :) сделать бы еще какнибудь эффект появления и скрытия, то вообще супер будет :)

killer   (2004-06-20 23:21:00) [16]

KnightМеню как PopupMenu, но только раскрывается сетка изображений.... т.е. сколько изображений в строке и сколько-то таких строк... все изображения разные, и какое-то из этих изображений можно выбрать... Понял теперь? :)

pasha_golub   (2004-06-20 21:44:00) [17]

Берем DG:TDrawGrid

DG.Visible := False;

Заполнение и рисование грида на вашей совести.

Далее, по нажатию на кнопку по которой должно появляться меню:

...
DG.Visible := True;
...

Далее ловим нажатие мыши на гриде либо "потерю фокуса гридом". Все.

Knight   (2004-06-20 21:34:00) [18]

Опиши, что именно требуется... меню бывают разные, а ICQ и Messanger у меня не установлены.

killer   (2004-06-20 17:07:00) [19]

Что-то у меня так и не получилось... :(

killer   (2004-06-20 14:15:00) [20]

KnightПриведи пожалуйста пример как ты это делаешь......

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо