5.2.3 Входные и выходные данные

Входными данными являются события мыши и соответствующие им графические изображения, которые установил пользователь.

Выходными данными являются изображения, выводимые в зависимости от события мыши.

5.2.4 Сообщения оператору

Компонент не генерирует сообщений оператору.

6 Приложение

6.1 Текст основного модуля компонента picturedbutton

procedure TPicturedButton.DrawCaption; {вывод надписи}

begin

Canvas.Brush.Style:=bsClear;

Canvas.Font:=Font;

TextLeft:=self.clientwidth-canvas.textwidth(caption);

TextLeft:=TextLeft div 2;

TextTop:=self.clientheight-canvas.textheight(caption);

TextTop:=TextTop div 2;

canvas.TextOut(TextLeft,TextTop,caption);

end;

constructor TPicturedButton.Create(AOwner: TComponent); {конструктор компонента}

begin

inherited Create(AOwner);

Parent := AOwner as TWinControl;

FMouseLeaveImage:=TBitmap.Create;

FClickImage:=TBitmap.Create;

FMouseEnterImage:=TBitmap.Create;

FMouseUpImage:=TBitmap.Create;

FDblClickImage:=TBitmap.Create;

FLeftMDownImage:=TBitmap.Create;

FRightMDownImage:=TBitmap.Create;

FMouseMoveImage:=TBitmap.Create;

Width := 100;

Height := 25;

Caption:=Name;

DrawCaption;

end;

{масштабирование изображения}

function TPicturedButton.SetSizePicture(bmp: TBitmap): TBitmap;

var

temp: TBitmap;

BtnProp, BmpProp: real;

begin

temp:=TBitmap.Create;

if FPictMode=pmProportional then

begin {изображение выводится полностью, пропорции сохраняются}

BtnProp:=Width/Height;

BmpProp:=Bmp.Width/Bmp.Height;

if BmpProp<=BtnProp then

begin

temp.Height:=Height;

temp.Width:=trunc(temp.Height*BmpProp)+1;

end

else

begin

temp.Width:=Width;

temp.Height:=trunc(temp.Width/BmpProp)+1;

end;

SetStretchBltMode(temp.Canvas.Handle, HALFTONE);

StretchBlt(temp.Canvas.Handle,0,0,temp.Width,temp.Height,Bmp.Canvas.Handle,0,0,Bmp.Width-2,Bmp.Height-2,SRCCOPY);

OutLeft:=trunc((width-4)/2)-trunc(temp.Width/2);

OutTop:=trunc((height-4)/2)-trunc(temp.Height/2);

end

else

if FPictMode=pmStretch then

begin {изобраение выводится полностью по размерам кнопки}

temp.Width:=Width-4;

temp.Height:=Height-4;

OutLeft:=2;

OutTop:=2;

SetStretchBltMode(temp.Canvas.Handle, HALFTONE);

StretchBlt(temp.Canvas.Handle,0,0,temp.Width,temp.Height,Bmp.Canvas.Handle,0,0,Bmp.Width-2,Bmp.Height-2,SRCCOPY);

end

else

begin {изображение сохраняет первоначальный размер}

if bmp.Width<(Width-4) then OutLeft:=trunc((Width-4)/2)-trunc(bmp.Width/2)

else OutLeft:=2;

if bmp.Height<(Height-4) then OutTop:=trunc((Height-4)/2)-trunc(bmp.Height/2)

else OutTop:=2;

temp:=bmp;

end;

SetSizePicture:=temp;

end;

procedure TPicturedButton.DrawPicture(Pict: TBitmap); {вывод изображения}

begin

if Pict.Handle<>0 then

begin

Canvas.Brush.Color:=Color;

Canvas.FillRect(Rect(0,0,width-1,height-1));

Canvas.Draw(OutLeft,OutTop,SetSizePicture(Pict));

end;

DrawCaption;

end;

procedure TPicturedButton.Loaded; {действия при загрузке компонента}

begin

inherited Loaded;

if MouseLeaveImage.Handle<>0 then DrawPicture(MouseLeaveImage);

DrawCaption;

end;

procedure TPicturedButton.SetCaption(Value: string);

begin

FCaption:=Value;

Paint;

end;

procedure TPicturedButton.SetMouseLeaveImage(Value: TBitmap);

begin

FMouseLeaveImage.Assign(Value);

end;

procedure TPicturedButton.SetClickImage(Value: TBitmap);

begin

FClickImage.Assign(Value);

end;

procedure TPicturedButton.SetMouseEnterImage(Value: TBitmap);

begin

FMouseEnterImage.Assign(Value);

end;

procedure TPicturedButton.SetMouseUpImage(Value: TBitmap);

begin

FMouseUpImage.Assign(Value);

end;

procedure TPicturedButton.SetDblClickImage(Value: TBitmap);

begin

FDblClickImage.Assign(Value);

end;

procedure TPicturedButton.SetLeftMDownImage(Value: TBitmap);

begin

FLeftMDownImage.Assign(Value);

end;

procedure TPicturedButton.SetRightMDownImage(Value: TBitmap);

begin

FRightMDownImage.Assign(Value);

end;

procedure TPicturedButton.SetMouseMoveImage(Value: TBitmap);

begin

FMouseMoveImage.Assign(Value);

end;

procedure TPicturedButton.SetPictMode(Value: TPictureMode);

begin

FPictMode:=Value;

end;

procedure TPicturedButton.BtnDown; {рисование нажатой кнопки}

begin

with Canvas do

begin

Pen.Width:=1;

Pen.Color:=ColorToRGB(Color)-$464646;

MoveTo(width-1,0);

LineTo(0,0);

LineTo(0,height-1);

LineTo(width-1,height-1);

LineTo(width-1,0);

Pen.Color:=ColorToRGB(Color)-$131313;

MoveTo(width-2,1);

LineTo(1,1);

LineTo(1,height-2);

LineTo(width-2,height-2);

LineTo(width-2,1);

end;

end;

procedure TPicturedButton.BtnUp; {рисование отпущенной кнопки}

begin

with Canvas do

begin

Pen.Width:=1;

Pen.Color:=ColorToRGB(Color)+$0f0f0f;

MoveTo(width-1,0);

LineTo(0,0);

LineTo(0,height-1);

Pen.Color:=ColorToRGB(Color)-$8a8a8a;

LineTo(width-1,height-1);

LineTo(width-1,0);

Pen.Color:=ColorToRGB(Color)-$131313;

MoveTo(width-2,1);

LineTo(1,1);

LineTo(1,height-2);

Pen.Color:=ColorToRGB(Color)-$464646;

LineTo(width-2,height-2);

LineTo(width-2,1);

end;

end;

procedure TPicturedButton.Paint;

begin

inherited Paint;

Canvas.Brush.Color:=Color;

Canvas.FillRect(Rect(0,0,width,height));

BtnUp;

DrawCaption;

end;

procedure TPicturedButton.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);

begin

inherited MouseDown(Button, Shift, X, Y);

if (csDesigning in ComponentState) then Exit

else

case Button of

mbLeft: DrawPicture(LeftMDownImage);

mbRight: DrawPicture(RightMDownImage);

end;

BtnDown;

end;

procedure TPicturedButton.MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);

begin

inherited MouseUp(Button, Shift, X, Y);

if (csDesigning in ComponentState) then Exit

else DrawPicture(MouseUpImage);

BtnUp;

end;

procedure TPicturedButton.MouseEnter(var msg: TMessage);

begin

if (csDesigning in ComponentState) then Exit

else if MouseEnterImage.Handle<>0 then DrawPicture(MouseEnterImage)

else

begin

Canvas.Brush.Color:=Color;

Canvas.FillRect(Rect(0,0,width-1,height-1));

DrawCaption;

end;

BtnUp;

end;

procedure TPicturedButton.MouseMove(Shift: TShiftState; X, Y: integer);

begin

inherited MouseMove(Shift, X, Y);

if (csDesigning in ComponentState) then Exit

else DrawPicture(MouseMoveImage);

BtnUp;

end;

procedure TPicturedButton.MouseLeave(var msg: TMessage);

begin

if (csDesigning in ComponentState) then Exit

else if MouseLeaveImage.Handle<>0 then DrawPicture(MouseLeaveImage)

else

begin

Canvas.Brush.Color:=Color;

Canvas.FillRect(Rect(0,0,width-1,height-1));

DrawCaption;

end;

BtnUp;

end;

procedure TPicturedButton.DblClick;

begin

inherited DblClick;

if (csDesigning in ComponentState) then Exit

else if MDblClickImage.Handle<>0 then DrawPicture(MDblClickImage)

else

begin

Canvas.Brush.Color:=Color;

Canvas.FillRect(Rect(0,0,width-1,height-1));

DrawCaption;

end;

BtnUp;

end;

procedure TPicturedButton.Click;

begin

inherited Click;

if (csDesigning in ComponentState) then Exit

else if ClickImage.Handle<>0 then DrawPicture(ClickImage)

else

begin

Canvas.Brush.Color:=Color;

Canvas.FillRect(Rect(0,0,width-1,height-1));

DrawCaption;

end;

BtnUp;

end;

end.