Button MouseMove olayı problemi

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
kutercakal007
Üye
Mesajlar: 25
Kayıt: 04 Ara 2010 12:34

Button MouseMove olayı problemi

Mesaj gönderen kutercakal007 »

Merhabalar arkadaşlar kolay gelsin.
1. Oluşturduğum formdaki butonun Flat özelliği True.
2. Butonun MouseMove olayına, mouse üzerine geldiğinde font.color ozelliğini değiştirecek bi kod yazmaya çalışıyorum. Aslında yazıyorum ama amacına uygun değil
yani mouse o butonun üzerinden gitse bile font.color özelliği eski haline gelmiyor.
3. Bu sorunun çözümü için akşam 9'dan beri araştırma yapıyorum ama bir türlü çözüm bulamadım. Formu aradım bununla alakalı bi çözüm belirtilmemiş.
4. En sonunda yabancı bi formda şöyle bi kod buldum çalışıyor ama bir sıkıntı var. Butonun Flat özelliği ne True ne False oluyor sadece yazı gorunuyor ve butonu çalıştırmak
için 2 kere tıklamak gerekiyor.
ALINTI :

Kod: Tümünü seç

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (X<0) or (Y<0) or (X>Button1.Width) or (Y>Button1.Height) then
begin
{The cursor is out of the control}
Button1.Font.Style:=[];
ReleaseCapture;
end else
begin
{The cursor is within the Button's bounds}
Button1.Font.Style:=[fsBold];
SetCaptureControl(Button1);
end;
end;
Bana bu konuda yardımcı olabilir misiniz :(
RamazanG
Üye
Mesajlar: 73
Kayıt: 16 Tem 2010 03:38

Re: Button MouseMove olayı problemi

Mesaj gönderen RamazanG »

Normalde çalışma zamanında Button1.Font.color:=DEĞİŞTİRİLEMEZ,, ama sınıf tanımlaması yaparak buttonun arka plan rengini ve font rengini çalışma zamanında değiştirebilirsin.

uses buttons; ekle

Kod: Tümünü seç


Uses Buttons; //Ekle
//Tür Tanımlaması Aşşağıdaki gibi Olacak

{Yeni Button Sınıfının Tanımlaması}
  TButton = class(StdCtrls.TButton)
  private
    FMouseOver, FMousePressed, FKeyboardPressed : Boolean;
    FCanvas : TCanvas;
    FColorEnter, FColorExit, FFontColorEnter, FFontColorExit : TColor;
    procedure SetColorEnter(value : TColor);
    procedure SetColorExit(value : TColor);
    procedure SetFontColorEnter(value : TColor);
    procedure SetFontColorExit(value : TColor);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure WndProc(var Message : TMessage); override;
    procedure CMMOUSEENTER(var Message : TMessage); message CM_MOUSEENTER;
    procedure CMMOUSELEAVE(var Message : TMessage); message CM_MOUSELEAVE;
    procedure CMEXIT(var Message : TMessage); message CM_EXIT;
    procedure WMSETFOCUS(var Message : TMessage); message WM_SETFOCUS;
    procedure WMKILLFOCUS(var Message : TMessage); message WM_KILLFOCUS;
    procedure WMENABLE(var Message : TWMEnable); message WM_ENABLE;
    procedure DrawButton;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    property ColorEnter : TColor read FColorEnter write SetColorEnter default clBtnFace;
    property ColorExit : TColor read FColorExit write SetColorExit default clBtnFace;
    property FontColorEnter : TColor read FFontColorEnter write SetFontColorEnter default clBtnText;
    property FontColorExit : TColor read FFontColorExit write SetFontColorExit default clBtnText;
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
Formun ONCreate Olayına:

Kod: Tümünü seç

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.ColorEnter := clYellow;
  Button1.ColorExit := clRed;
  Button1.FontColorEnter :=clGreen;
  Button1.FontColorExit := clBlue;
end;
procedure TButton.CMEXIT(var Message: TMessage);

Kod: Tümünü seç

procedure TButton.CMEXIT(var Message: TMessage);
begin
    inherited;
  FMousePressed := False;
  FKeyboardPressed := False;

end;
procedure TButton.CMMOUSEENTER(var Message: TMessage);

Kod: Tümünü seç

procedure TButton.CMMOUSEENTER(var Message: TMessage);
begin
     inherited;
  if Enabled then
  begin
    FMouseOver := True;
    Invalidate;
  end;

end;

procedure TButton.CMMOUSELEAVE(var Message: TMessage);

Kod: Tümünü seç

procedure TButton.CMMOUSELEAVE(var Message: TMessage);
begin
    inherited;
  if Enabled then
  begin
    FMouseOver := False;
    Invalidate;
  end;

end;

constructor TButton.Create(AOwner: TComponent);

Kod: Tümünü seç

constructor TButton.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
  FCanvas := TCanvas.Create;
  FCanvas.Handle := GetWindowDC(Handle);
  FColorEnter := clBtnFace;
  FColorExit := clBtnFace;
  FFontColorEnter := clBtnText;
  FFontColorExit := clBtnText;
  FMouseOver := False;
  FMousePressed := False;
  FKeyboardPressed := False;
end;
destructor TButton.Destroy;

Kod: Tümünü seç

destructor TButton.Destroy;
begin

  FCanvas.Free;
  inherited Destroy;

end;
procedure TButton.DrawButton;

Kod: Tümünü seç


procedure TButton.DrawButton;
var
  RC : TRect;
begin
  with FCanvas do
  begin
    RC := ClientRect;
    InflateRect(rc,-2,-2);
    Font.Assign(Self.Font);

    if FMouseOver then
    begin
      Color := FColorEnter;
      Font.Color := FFontColorEnter;
    end
    else
    begin
      Color := FColorExit;
      Font.Color := FFontColorExit;
    end;

    Brush.Color := Color;

    if not Enabled then
      Brush.Color := FColorExit;

    if Self = TCustomForm(Parent).ActiveControl then
    begin
      if not ((FMousePressed and FMouseOver) or (FKeyboardPressed and not FMousePressed)) then
        InflateRect(RC,-1,-1);
      FillRect(RC);

      if Caption <> '' then
        if Focused then
          DrawFocusRect(Rect(4,4,Width - 4, Height - 4));
    end
    else
    begin
      if Default then
        if not (TCustomForm(Parent).ActiveControl is TButtonControl) then
          InflateRect(RC, -1, -1);

      FillRect(RC);
    end;

    RC := ClientRect;

    if (FMousePressed and FMouseOver) or (FKeyboardPressed and not FMousePressed) then
      OffSetRect(RC, 1, 1);

    SetBkMode(Handle, TRANSPARENT);

    if Enabled then
      DrawText(Handle,PChar(Caption), Length(PChar(Caption)),RC,DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_NOCLIP)
    else
    begin
      OffSetRect(RC,1,1);
      Font.Color := clCaptionText;
      DrawText(Handle,PChar(Caption), Length(PChar(Caption)),RC,DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_NOCLIP);
      OffSetRect(RC,-1,-1);
      Font.Color := clInactiveCaption;
      DrawText(Handle,PChar(Caption), Length(PChar(Caption)),RC,DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_NOCLIP)
    end;
  end;


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

Kod: Tümünü seç

procedure TButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
   inherited MouseDown(Button, Shift, X,Y);
  if Button = mbLeft then
    FMousePressed := True;


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

Kod: Tümünü seç

procedure TButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
    inherited MouseUp(Button, Shift, X,Y);
  if Button = mbLeft then
  begin
    if FKeyboardPressed then
    begin
      Perform(WM_KEYDOWN,VK_SPACE,0);
      FKeyboardPressed := False;
    end;
    FMousePressed := False;
  end;


end;
procedure TButton.SetColorEnter(value: TColor);

Kod: Tümünü seç

procedure TButton.SetColorEnter(value: TColor);
begin
    if Value <> FColorEnter then
  begin
    FColorEnter := Value;
    Invalidate;
  end;

end;
procedure TButton.SetColorExit(value: TColor);

Kod: Tümünü seç

procedure TButton.SetColorExit(value: TColor);
begin
     if Value <> FColorExit then
  begin
    FColorExit := Value;
    Invalidate;
  end;

end;

procedure TButton.SetFontColorEnter(value: TColor);

Kod: Tümünü seç

procedure TButton.SetFontColorEnter(value: TColor);
begin
     if Value <> FColorEnter then
  begin
    FFontColorEnter := Value;
    Invalidate;
  end;

end;
procedure TButton.SetFontColorExit(value: TColor);

Kod: Tümünü seç

procedure TButton.SetFontColorExit(value: TColor);
begin
    if Value <> FColorExit then
  begin
    FFontColorExit := Value;
    Invalidate;
  end;

end;
procedure TButton.WMENABLE(var Message: TWMEnable);

Kod: Tümünü seç

procedure TButton.WMENABLE(var Message: TWMEnable);
begin
     inherited;
  Invalidate;

end;
procedure TButton.WMKILLFOCUS(var Message: TMessage);

Kod: Tümünü seç

procedure TButton.WMKILLFOCUS(var Message: TMessage);
var
  CursorPos : TPoint;
begin
  inherited;
  GetCursorPos(CursorPos);
  CursorPos := ScreenToClient(CursorPos);
  if ((CursorPos.X > 0) and (CursorPos.X < Width)) and
     ((CursorPos.Y > 0) and (CursorPos.Y < Height)) then
    Perform(CM_MOUSEENTER,0,0)
  else
    Perform(CM_MOUSELEAVE,0,0);
end;
procedure TButton.WMSETFOCUS(var Message: TMessage);

Kod: Tümünü seç

procedure TButton.WMSETFOCUS(var Message: TMessage);
var
  CursorPos : TPoint;
begin
  inherited;
  GetCursorPos(CursorPos);
  CursorPos := ScreenToClient(CursorPos);
  if ((CursorPos.X > 0) and (CursorPos.X < Width)) and
     ((CursorPos.Y > 0) and (CursorPos.Y < Height)) then
    Perform(CM_MOUSEENTER,0,0)
  else
    Perform(CM_MOUSELEAVE,0,0);
end;
procedure TButton.WndProc(var Message: TMessage);

Kod: Tümünü seç

procedure TButton.WndProc(var Message: TMessage);
begin
 inherited;
  with Message do
  begin
    case Msg of
      WM_SHOWWINDOW, WM_PAINT, WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK,
      WM_KILLFOCUS , WM_SETFOCUS :
      begin
        if Msg = WM_KILLFOCUS then
        begin
          FMousePressed := False;
          FKeyboardPressed := False;
        end;

        DrawButton;
      end;

      WM_KEYUP :
        if TWMKeyUp(Message).CharCode = VK_SPACE then
        begin
          FKeyboardPressed := False;
          DrawButton;
        end;

      WM_KEYDOWN :
      begin
       if (TWMKeyDown(Message).CharCode = VK_SPACE) and not (FKeyboardPressed) then
       begin
         FKeyboardPressed := True;
         DrawButton;
       end
       else
         if TWMKeyDown(Message).CharCode <> VK_SPACE then
         begin
           FKeyboardPressed := False;
           DrawButton;
         end;
      end;
    end;
  end;
end;
end.

Yukarıdaki kod çalışma zamanında imleç buttonun üzerine gelince buttonun arkaplan rengini ve font rengini değiştirir.

Eğer ikon animasyonu kullanmak istersen:
global olarak tanımla:

Kod: Tümünü seç

var 
  IconIndex : integer = 0; 
bir imagelist ekle ve bir timer ekle. timerin OnTimer olayına:

Kod: Tümünü seç

procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  ImageList1.GetIcon(IconIndex,Icon); 
  Inc(IconIndex); 
  if IconIndex = ImageList1.Count then 
    IconIndex := 0; 
end; 

kutercakal007
Üye
Mesajlar: 25
Kayıt: 04 Ara 2010 12:34

Re: Button MouseMove olayı problemi

Mesaj gönderen kutercakal007 »

Hocam verdiğiniz kodlar çok işime yaradı daha önce buna benzer bulmuştum ama bu kadar kapsamlı değildi elinize emeğinize sağlık çok işime yaradı. Aynen dediğiniz gibi butonun üstüne gelince renk değişiyor ve butonun tek seferde tıklanmama sorunu ortadan kalktı tekrardan çok teşekkürler :)
Kullanıcı avatarı
KoPilot
Üye
Mesajlar: 185
Kayıt: 05 Eki 2007 08:02

Re: Button MouseMove olayı problemi

Mesaj gönderen KoPilot »

kutercakal007 yazdı:Hocam verdiğiniz kodlar çok işime yaradı daha önce buna benzer bulmuştum ama bu kadar kapsamlı değildi elinize emeğinize sağlık çok işime yaradı. Aynen dediğiniz gibi butonun üstüne gelince renk değişiyor ve butonun tek seferde tıklanmama sorunu ortadan kalktı tekrardan çok teşekkürler :)
Yarıyacak tabii :mrgreen:
Adam resmen yeni bir component yazmış.. :bravo:
Eyvallah hocam.. Eline emeğine sağlık..
Dosyalarınızı kendi bulutunuza yedekleyin. Yandex Disk
Eyvallah..
Cevapla