Форум: "KOL";
Текущий архив: 2008.03.23;
Скачать: [xml.tar.bz2];
ВнизПодобие кнопки в стиле XP. Найти похожие ветки
← →
nikfel © (2007-08-01 11:16) [0]Пожалуйста подскажите. Как сделать нечто вроде кнопки. Я пытался использовать Paintbox, но зашел в тупик.
Вот код, но не выходит только одно. Мне надо, чтобы при нажатии кнопки и убирании курсора мыши при нажатой кнопке кнопка перерисовывалась в обычное состояние, а у меня получается что кнопка остается нажатой. Вроде все перепробовал не работает. Может есть другой способ такой кнопки.Заранее спасибо.
uses paintbut;
procedure TForm1.KOLForm1FormCreate(Sender: PObj);
var i:integer;
begin
for i:=1 to 10 do begin
button[i]:=NewPaintbox(form);
button[i].Height:=32;
button[i].Width:=form.Width;
button[i].Tag:=i;
if i<>1 then begin
button[i].Top:=button[i-1].Top+32+1;
end;
button[i].OnPaint:=paintbutton;
button[i].OnMouseMove:=MouseMovebutton;
button[i].OnMouseDown:=MouseDownbutton;
button[i].OnMouseUp:=MouseUpbutton;
button[i].OnMouseLeave:=MouseLeavebutton;
end;
form.Height:=10*32+10;
focus:=1;
mousedown:=0;
end;
procedure TForm1.paintbutton(Sender:Pcontrol;DC:HDC);
begin
Paintbut1(sender);
if focus=sender.Tag then begin
PaintbutMouseMove(sender);
end;
end;
procedure TForm1.MouseMovebutton(Sender: PControl;
var Mouse: TMouseEventData);
begin
if (mousedown=1) and (focus=sender.Tag) then begin
PaintButMouseDown(sender);
end;
if (getkeystate(1)=-128)or
(getkeystate(1)=-127)then
begin
exit;
end else begin
mousedown:=0;
end;
if focus<>sender.Tag then begin
Paintbut1(button[focus]);
end;
focus:=sender.Tag;
PaintbutMouseMove(sender);
end;
procedure TForm1.MouseDownbutton(Sender: PControl;
var Mouse: TMouseEventData);
begin
if mouse.Button=mbleft then begin
PaintButMouseDown(sender);
mousedown:=1;
end;
end;
procedure TForm1.MouseUpbutton(Sender: PControl;
var Mouse: TMouseEventData);
begin
if mouse.Button=mbleft then begin
Paintbut1(sender);
PaintbutMouseMove(sender);
mousedown:=0;
if focus<>sender.Tag then begin
Paintbut1(button[focus]);
end;
end;
end;
procedure TForm1.MouseLeavebutton(Sender: PObj);
begin
///
end;
//Содержание paintbut.pas:
unit paintbut;
interface
uses
kol,windows;
const colorw:array[1..15] of tcolor=
($00C6CFD6,$00C8D1D8,$00CBD4DA,$00CDD6DD,
$00D0D9DF,$00D2DBE1,$00D5DDE3,$00D7E0E5,
$00DCE5EA,$00DFE7EC,$00E1E9EE,$00E4ECF0,
$00E6EEF3,$00E9F1F5,$00EBF3F7);
const colorq:array[1..15] of tcolor=
($00E0FD9A,$00DCF990,$00D7F486,$00D3F07C,
$00CFEB72,$00CBE768,$00C6E25E,$00C2DE54,
$00BAD540,$00B5D036,$00B1CC2C,$00ADC722,
$00A9C318,$00A4BE0E,$00A0BA04);
const colort:array[1..15] of tcolor=
($00FFFDF9,$00FFFCF6,$00FFFBF3,
$00FFFAF0,$00FFF9ED,$00FFF8EA,$00FFF7E7,
$00FFF6E4,$00FFF5E1,$00FFF4DE,$00FFF3DB,
$00FFF2D8,$00FFF1D5,$00FFF0D2,$00FFEFCF);
function settextbut(Sender:Pcontrol;strS:string):string;
procedure Paintbut1(Sender: PControl);
procedure PaintbutMouseMove(Sender: PControl);
procedure PaintButMouseDown(Sender: PControl);
implementation
procedure pix(Sender:Pcontrol);
begin
Sender.Canvas.Pixels[1,1]:=clSkyBlue;
Sender.Canvas.Pixels[1,Sender.Height-2]:=clSkyBlue;
Sender.Canvas.Pixels[Sender.Width-2,1]:=clSkyBlue;
Sender.Canvas.Pixels[Sender.Width-2,Sender.Height-2]:=clSkyBlue;
end;
function settextbut(Sender:Pcontrol;strS:string):string;
begin
Sender.Canvas.Brush.BrushStyle:=bsClear;
SetBkMode(Sender.Canvas.Handle, TRANSPARENT);
Sender.Canvas.TextOut(((Sender.Width-Sender.Canvas.TextWidth(strS)) div 2), (Sender.Height-Sender.Canvas.TextHeight(strS)) div 2, strS);
Sender.Canvas.Brush.BrushStyle:=bsSolid;
end;
procedure Paintbut1(Sender: PControl);
var q,w:integer;
begin
w:=1;
For q:=1 to 15 do begin
Sender.Canvas.Brush.Color:=colort[q];
Sender.Canvas.FillRect(MakeRect(1,w,Sender.Width-1,w+2));
w:=w+2;
end;
Sender.Canvas.Brush.Color:=clSkyBlue;
Sender.Canvas.FillRect(MakeRect(0,0,Sender.Width,1));
Sender.Canvas.FillRect(MakeRect(0,sender.Height-1,Sender.Width,sender.Height));
Sender.Canvas.FillRect(MakeRect(0,0,1,sender.Height));
Sender.Canvas.FillRect(MakeRect(sender.Width-1,0,Sender.Width,sender.Height));
pix(Sender);
Sender.Canvas.Pixels[0,0]:=clBtnFace;
Sender.Canvas.Pixels[0,Sender.Height-1]:=clBtnFace;
Sender.Canvas.Pixels[Sender.Width-1,0]:=clBtnFace;
Sender.Canvas.Pixels[Sender.Width-1,Sender.Height-1]:=clBtnFace;
Sender.Canvas.Pixels[1,0]:=$00EEF2DF;
Sender.Canvas.Pixels[0,1]:=$00EEF2DF;
Sender.Canvas.Pixels[0,Sender.Height-2]:=$00EEF2DF;
Sender.Canvas.Pixels[1,Sender.Height-1]:=$00EEF2DF;
Sender.Canvas.Pixels[Sender.Width-2,0]:=$00EEF2DF;
Sender.Canvas.Pixels[Sender.Width-1,1]:=$00EEF2DF;
Sender.Canvas.Pixels[Sender.Width-1,Sender.Height-2]:=$00EEF2DF;
Sender.Canvas.Pixels[Sender.Width-2,Sender.Height-1]:=$00EEF2DF;
end;
procedure PaintbutMouseMove(Sender: PControl);
var intT,intY,intX:integer;
begin
intY:=2;
intX:=1;
for intT:=1 to 14 do begin
Sender.Canvas.Brush.Color:=colorq[intT+1];
Sender.Canvas.FillRect(MakeRect(intX,intY,intX+2,intY+2));
intY:=intY+2;
end;
intY:=2;
intX:=Sender.Width-3;
for intT:=1 to 14 do begin
Sender.Canvas.Brush.Color:=colorq[intT+1];
Sender.Canvas.FillRect(MakeRect(intX,intY,intX+2,intY+2));
intY:=intY+2;
end;
Sender.Canvas.Brush.Color:=colorq[1];
Sender.Canvas.FillRect(MakeRect(2,1,Sender.Width-2,2));
Sender.Canvas.Brush.Color:=colorq[2];
Sender.Canvas.FillRect(MakeRect(2,2,Sender.Width-2,3));
Sender.Canvas.Brush.Color:=colorq[15];
Sender.Canvas.FillRect(MakeRect(2,Sender.Height-3,Sender.Width-2,Sender.Height-1));
end;
procedure PaintButMouseDown(Sender: PControl);
var q,w:integer;
begin
w:=1;
For q:=1 to 15 do begin
Sender.Canvas.Brush.Color:=colorw[q];
Sender.Canvas.FillRect(MakeRect(1,w,Sender.Width-1,w+2));
w:=w+2;
end;
pix(Sender);
end;
end.
← →
Дмитрий К © (2007-08-01 11:26) [1]В OnMouseDown проверять находится ли курсор внутри кнопки, если нет рисовать отжатую.
← →
Nikfel © (2007-08-01 12:20) [2]А как это сделать.
← →
=BuckLr= (2007-08-01 13:04) [3]Дмитрий К дело говорит. Но я добавлю, что лучше использовать не OnMouseMove, а OnMouseEnter + OnMouseLeave. В OnMouseEnter рисуешь нажатый рисунок, а в OnMouseLeave - отжатый. Ну и в OnMouseDown тоже нажатый.
← →
Дмитрий К © (2007-08-01 13:25) [4]Дело-то - дело, только я думал, что MouseDown посылается пока нажата кнопка, ан нет - один раз посылается.
Проверил - красивые кнопки получаются. И кнопка отжимается если назначен обработчик MouseLeave.
← →
Дмитрий К © (2007-08-01 14:31) [5]Вот примерный код использующий Leave/Enter:
program pbbut;
uses
Windows,
Messages,
Kol,
paintbut in "paintbut.pas";
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
form, btn, pb: PControl;
button: array [1..10] of PControl;
public
procedure MouseDown(Sender: PControl; var Mouse: TMouseEventData);
procedure MouseLeave(Sender:PObj);
procedure MouseEnter(Sender:PObj);
// procedure MouseMove(Sender: PControl; var Mouse: TMouseEventData);
procedure MouseUp(Sender: PControl; var Mouse: TMouseEventData);
procedure DoPaint(Sender:Pcontrol;DC:HDC);
end;
var
Form1: PForm1;
type
TBtnOpts = packed record
case integer of
0: (boPressed: Boolean; boFocused: Boolean; Reserved: word);
1: (Tag: Integer)
end;
procedure NewForm1(var Result: PForm1; AParent: PControl);
var i: integer;
begin
New(Result, Create);
with Result^ do
begin
form := NewForm(AParent, "Form1");
form.Add2AutoFree(Result);
Applet := form;
for i:=1 to 10 do
begin
button[i]:=NewPaintbox(form);
button[i].Height:=32;
button[i].Width:=200;
button[i].Tag:=0;
if i<>1 then
button[i].Top:=button[i-1].Top+32+1;
button[i].OnPaint:=DoPaint;
// button[i].OnMouseMove:=MouseMove;
button[i].OnMouseDown:=MouseDown;
button[i].OnMouseUp:=MouseUp;
button[i].OnMouseLeave:=MouseLeave;
button[i].OnMouseEnter:=MouseEnter;
end;
button[10].ResizeParent;
// form.Height:=10*32+10;
end;
end;
procedure PaintButton(Sender: PControl; Focused, Pressed: Boolean);
begin
PaintBut1(Sender);
if focused then
PaintbutMouseMove(Sender) else
if Pressed then
PaintbutMouseDown(Sender);
end;
{ TForm1 }
procedure TForm1.DoPaint(Sender:Pcontrol; DC:HDC);
var BO: TBtnOpts;
begin
BO.Tag := Sender.Tag;
PaintButton(Sender, BO.boFocused, BO.boPressed);
end;
procedure TForm1.MouseEnter(Sender: PObj);
var BO: TBtnOpts;
begin
BO.boPressed := False;
BO.boFocused := True;
PControl(Sender).Tag := BO.Tag;
PControl(Sender).Invalidate;
end;
procedure TForm1.MouseLeave(Sender: PObj);
var BO: TBtnOpts;
begin
BO.boPressed := False;
BO.boFocused := False;
Sender.Tag := BO.Tag;
PControl(Sender).Invalidate;
end;
procedure TForm1.MouseDown(Sender: PControl; var Mouse: TMouseEventData);
var BO: TBtnOpts;
begin
if mouse.Button = mbleft then
begin
BO.boPressed := True;
BO.boFocused := False;
Sender.Tag := BO.Tag;
sender.Invalidate;
end;
end;
procedure TForm1.MouseUp(Sender: PControl; var Mouse: TMouseEventData);
var BO: TBtnOpts;
begin
if mouse.Button=mbleft then
begin
BO.boPressed := False;
BO.boFocused := True;
Sender.Tag := BO.Tag;
sender.Invalidate;
end;
end;
begin
NewForm1(Form1, nil);
Run(Applet);
end.
← →
Nikfel © (2007-08-01 14:53) [6]Большое спасибо за код.
← →
Дмитрий К © (2007-08-01 15:10) [7]
> Большое спасибо за код.
Пожалуйста.
Вот так будет немного интереснее:program pbbut;
uses
Windows,
Messages,
Kol,
paintbut in "paintbut.pas";
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
form, btn, pb: PControl;
button: array [1..10] of PControl;
public
procedure MouseDown(Sender: PControl; var Mouse: TMouseEventData);
procedure MouseLeave(Sender:PObj);
procedure MouseEnter(Sender:PObj);
// procedure MouseMove(Sender: PControl; var Mouse: TMouseEventData);
procedure MouseUp(Sender: PControl; var Mouse: TMouseEventData);
procedure DoPaint(Sender:Pcontrol;DC:HDC);
end;
var
Form1: PForm1; GlobalID: Integer;
type
TBtnOpts = packed record
case integer of
0: (ID: word; boPressed: Boolean; boFocused: Boolean;);
1: (Tag: Integer)
end;
procedure NewForm1(var Result: PForm1; AParent: PControl);
var i: integer;
begin
New(Result, Create);
with Result^ do
begin
form := NewForm(AParent, "Form1");
form.Add2AutoFree(Result);
Applet := form;
for i:=1 to 10 do
begin
button[i]:=NewPaintbox(form);
button[i].Height:=32;
button[i].Width:=200;
button[i].Tag:=i;
if i<>1 then
button[i].Top:=button[i-1].Top+32+1;
button[i].OnPaint:=DoPaint;
// button[i].OnMouseMove:=MouseMove;
button[i].OnMouseDown:=MouseDown;
button[i].OnMouseUp:=MouseUp;
button[i].OnMouseLeave:=MouseLeave;
button[i].OnMouseEnter:=MouseEnter;
end;
button[10].ResizeParent;
// form.Height:=10*32+10;
end;
end;
procedure PaintButton(Sender: PControl; Focused, Pressed: Boolean);
begin
PaintBut1(Sender);
if focused then
PaintbutMouseMove(Sender) else
if Pressed then
PaintbutMouseDown(Sender);
end;
{ TForm1 }
procedure TForm1.DoPaint(Sender:Pcontrol; DC:HDC);
var BO: TBtnOpts; c: PChar;
begin
BO.Tag := Sender.Tag;
PaintButton(Sender, BO.boFocused, BO.boPressed);
c:=PChar(int2str(Sender.Tag));
SetBkMode(dc,Transparent);
TextOut(DC,4,4, c,strlen(c));
end;
procedure TForm1.MouseEnter(Sender: PObj);
var BO: TBtnOpts;
begin
with BO do
begin
Tag := PControl(Sender).Tag;
boPressed := False;
boFocused := True;
PControl(Sender).Tag := Tag;
end;
PControl(Sender).Invalidate;
end;
procedure TForm1.MouseLeave(Sender: PObj);
var BO: TBtnOpts;
begin
with BO do
begin
Tag := PControl(Sender).Tag;
boPressed := False;
boFocused := False;
Sender.Tag := Tag;
end;
PControl(Sender).Invalidate;
end;
procedure TForm1.MouseDown(Sender: PControl; var Mouse: TMouseEventData);
var BO: TBtnOpts;
begin
if mouse.Button = mbleft then
begin
with BO do
begin
Tag := Sender.Tag;
GlobalID := ID;
boPressed := True;
boFocused := False;
Sender.Tag := Tag;
end;
sender.Invalidate;
end;
end;
procedure TForm1.MouseUp(Sender: PControl; var Mouse: TMouseEventData);
var BO: TBtnOpts;
begin
if mouse.Button=mbleft then
begin
with BO do
begin
Tag := Sender.Tag;
boPressed := False;
boFocused := True;
Sender.Tag := Tag;
end;
sender.Invalidate;
if GlobalID = BO.ID then
msgOK("Обработка нажатия"#13#10 + "Кнопка "+int2str(BO.ID));
end;
end;
begin
NewForm1(Form1, nil);
Run(Applet);
end.
← →
Nikfel © (2007-08-01 19:21) [8]Как сделать точное подобие кнопки.Код просто отличный, но не выходит сделать так чтобы фокусная рамка оставалась после убирания курсора. Стоит ли использовать OnMouseMove. Я попробовал добавить в программу OnMouseMove и программа перестала работать. От чего это зависит. Я все равно попробую с этим разобраться. Не могли бы вы пояснить некоторые переменные. Если вас не затруднит то ответьте на вопрос.
← →
nikfel © (2007-08-07 09:46) [9]Я разобрался как сделать нечто схожее с кнопкой в стиле XP.
Вот доработанный верхний код:
program pbbut;
uses
Windows,
Messages,
Kol,
paintbut in "paintbut.pas";
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
form: PControl;
button: array [1..10] of PControl;
public
procedure MouseDown(Sender: PControl; var Mouse: TMouseEventData);
procedure MouseLeave(Sender:PObj);
procedure MouseEnter(Sender:PObj);
procedure MouseUp(Sender: PControl; var Mouse: TMouseEventData);
procedure DoPaint(Sender:Pcontrol;DC:HDC);
end;
var
Form1: PForm1; GlobalID: Integer;
focus:integer;
type
TBtnOpts = packed record
case integer of
0: (ID: word; boPressed: Boolean; boFocused: Boolean;);
1: (Tag: Integer)
end;
procedure NewForm1(var Result: PForm1; AParent: PControl);
var i: integer;
begin
New(Result, Create);
with Result^ do
begin
form := NewForm(AParent, "Form1");
form.Add2AutoFree(Result);
Applet := form;
for i:=1 to 10 do
begin
button[i]:=NewPaintbox(form);
button[i].Height:=32;
button[i].Width:=200;
button[i].Tag:=i;
if i<>1 then
button[i].Top:=button[i-1].Top+32+1;
button[i].OnPaint:=DoPaint;
button[i].OnMouseDown:=MouseDown;
button[i].OnMouseUp:=MouseUp;
button[i].OnMouseLeave:=MouseLeave;
button[i].OnMouseEnter:=MouseEnter;
end;
button[10].ResizeParent;
focus:=1;
end;
end;
procedure PaintButton(Sender: PControl; Focused, Pressed: Boolean);
begin
PaintBut1(Sender);
if focus=sender.Tag then
PaintbutMouseLeave(Sender) else
if focused then
PaintbutMouseMove(Sender) else
if Pressed then
PaintbutMouseDown(Sender);
end;
{ TForm1 }
procedure TForm1.DoPaint(Sender:Pcontrol; DC:HDC);
var BO: TBtnOpts; c: PChar;
begin
BO.Tag := Sender.Tag;
PaintButton(Sender, BO.boFocused, BO.boPressed);
c:=PChar(int2str(Sender.Tag));
SetBkMode(dc,Transparent);
TextOut(DC,4,4, c,strlen(c));
end;
procedure TForm1.MouseEnter(Sender: PObj);
var BO: TBtnOpts;
begin
if ((getkeystate(1)=-128)or
(getkeystate(1)=-127)) and (GlobalID<>PControl(Sender).Tag) then begin
exit;
end;
if focus<>PControl(Sender).Tag then begin
paintbut1(button[focus]);
button[focus].Canvas.Brush.BrushStyle:=bsClear;
SetBkMode(button[focus].Canvas.Handle, TRANSPARENT);
button[focus].Canvas.TextOut(4,4,int2str(focus));
button[focus].Canvas.Brush.BrushStyle:=bsSolid;
end;
focus:=PControl(Sender).Tag;
with BO do
begin
Tag := PControl(Sender).Tag;
if ((getkeystate(1)=-128)or
(getkeystate(1)=-127)) and (GlobalID=id) then begin
boPressed := True;
boFocused := False;
end else begin
boPressed := False;
boFocused := True;
end;
PControl(Sender).Tag := Tag;
end;
PControl(Sender).Invalidate;
if (getkeystate(1)=-128)or
(getkeystate(1)=-127) then begin
exit;
end else begin
if GlobalID>0 then begin
paintbut1(button[GlobalID]);
button[GlobalID].Canvas.Brush.BrushStyle:=bsClear;
SetBkMode(button[GlobalID].Canvas.Handle, TRANSPARENT);
button[GlobalID].Canvas.TextOut(4,4,int2str(GlobalID));
button[GlobalID].Canvas.Brush.BrushStyle:=bsSolid;
GlobalID:=0;
end;
end;
end;
procedure TForm1.MouseLeave(Sender: PObj);
var BO: TBtnOpts;
begin
with BO do
begin
Tag := PControl(Sender).Tag;
boPressed := False;
boFocused := False;
Sender.Tag := Tag;
end;
PControl(Sender).Invalidate;
end;
procedure TForm1.MouseDown(Sender: PControl; var Mouse: TMouseEventData);
var BO: TBtnOpts;
begin
if mouse.Button = mbleft then
begin
with BO do
begin
Tag := Sender.Tag;
GlobalID := ID;
boPressed := True;
boFocused := False;
Sender.Tag := Tag;
end;
sender.Invalidate;
end;
end;
procedure TForm1.MouseUp(Sender: PControl; var Mouse: TMouseEventData);
var BO: TBtnOpts;
begin
if mouse.Button=mbleft then
begin
with BO do
begin
Tag := Sender.Tag;
boPressed := False;
boFocused := True;
Sender.Tag := Tag;
end;
sender.Invalidate;
if GlobalID = BO.ID then
msgOK("Обработка нажатия"#13#10 + "Кнопка "+int2str(BO.ID));
end;
if (getkeystate(1)=-128)or
(getkeystate(1)=-127) then begin
exit;
end else begin
if GlobalID>0 then begin
dopaint(button[GlobalID],0);
GlobalID:=0;
end;
if focus<>PControl(Sender).Tag then begin
paintbut1(button[focus]);
button[focus].Canvas.Brush.BrushStyle:=bsClear;
SetBkMode(button[focus].Canvas.Handle, TRANSPARENT);
button[focus].Canvas.TextOut(4,4,int2str(focus));
button[focus].Canvas.Brush.BrushStyle:=bsSolid;
end;
end;
end;
begin
NewForm1(Form1, nil);
Run(Applet);
end.
Добавить в файл paintbut.pas следующее:
const colorl:array[1..15] of tcolor=
($00FDF4B3,$00FAEFAB,$00F6EAA4,$00F3E59C,
$00F0DF95,$00EDDA8D,$00E9D586,$00E6D07E,
$00DFC56F,$00DBBF68,$00D8BA60,$00D5B459,
$00D2B051,$00CEAA4A,$00CBA542);
procedure PaintButMouseLeave(Sender: PControl);
var intT,intY,intX:integer;
begin
intY:=2;
intX:=1;
for intT:=1 to 14 do begin
Sender.Canvas.Brush.Color:=colorl[intT+1];
Sender.Canvas.FillRect(MakeRect(intX,intY,intX+2,intY+2));
intY:=intY+2;
end;
intY:=2;
intX:=Sender.Width-3;
for intT:=1 to 14 do begin
Sender.Canvas.Brush.Color:=colorl[intT+1];
Sender.Canvas.FillRect(MakeRect(intX,intY,intX+2,intY+2));
intY:=intY+2;
end;
Sender.Canvas.Brush.Color:=colorl[1];
Sender.Canvas.FillRect(MakeRect(2,1,Sender.Width-2,2));
Sender.Canvas.Brush.Color:=colorl[2];
Sender.Canvas.FillRect(MakeRect(2,2,Sender.Width-2,3));
Sender.Canvas.Brush.Color:=colorl[15];
Sender.Canvas.FillRect(MakeRect(2,Sender.Height-3,Sender.Width-2,Sender.Height-1));
end;
Возможно код требует доработки. Какую цветом лудше сделать рамку при убирании курсора(не могу подобрать цвет по лудше). Что думаете по поводу этого кода. Как устранить утечку памяти, если она есть.
Страницы: 1 вся ветка
Форум: "KOL";
Текущий архив: 2008.03.23;
Скачать: [xml.tar.bz2];
Память: 0.52 MB
Время: 0.006 c