Butonlu Edit Nesnesi (TupEditButon)

06 Ağustos 2009 Perşembe: Uğur Parlayan

Son zamanlarda kendimi programlamaya verdim ve Delphicilerin faydalanacağına emin olduğum bir nesnenin kaynak kodlarını burada yayınlamaktan mutluluk duyuyorum. "Gerekli miydi?" derseniz, "nerede kullanacağınıza bağlı" derim. Lafı döndürmeye gerek yok, doğrudan konuya girelim;

TupEditButon ne işe yarar

Bu bileşen, tek satırlık bir metin kutusudur (TEdit), fakat diğer metin kutularından farklı olarak bir de dahili bir buton içerir. Çok yoğun formlarda böyle şeyler genelde aranılan bileşenlerdir, gerek yer sıkıntısı yaşanmaması adına, gerekse görüntü kirliliği oluşturmaması açısından ve biraz da simetri hastası delphiciler bu tür bileşenleri daha çok tercih eder. Üstelik kullanıcılar da bu tür özellikleri daha çabuk kapar ve kısa sürede kullanımına alışırlar. Son olarak bu tür bir bileşeni çeşitlendirerek kendine özgü bileşen paketleri de üretebilme kolaylığınız vardır çünkü gayet sade ve gayet işlevsel bir kaynak koda sahiptir. Eğer aşağıdaki kaynak kodu doğru şekilde işlerseniz daha farklı bir çok yetenek kazandırabilirsiniz.

Hatırlatma açısından değinmekte fayda var, kod aralarına yeni paragraflar ekleyerek kodun bütünlüğünü, kolay anlaşılabilirliğini parçalamak istemedim, o nedenle gerekli açıklamaları kaynak kodun içinden okuyabilirsniz, ayrıca bu kaynak kodu Delphi 2007'de halâ kullanmaktayım (Tabi çok daha gelişmiş başka bir sürümünü :)


{******************************************************************************}
{*                                                                            *}
{*  Programlayan: Uğur Parlayan (ugurparlayan@gmail.com)                      *}
{*  Tarih: 06.08.2009                                                         *}
{*                                                                            *}
{*  Kullanım: Ayrım gözetmeksizn külliyatıyla ÜCRETSİZDİR                     *}
{*            Yazarın gönlü olsun diye kaynak belirtirseniz sevinirim...      *}
{*                                                                            *}
{*  URL: http://www.kavramca.com/index.php?k=31                             *}
{*                                                                            *}
{******************************************************************************}

unit upEditButon;

interface

uses
  SysUtils, Classes, StdCtrls, Mask, DBCtrls, DB, ExtCtrls, Controls,
  Buttons, Messages, Graphics, Windows, Forms, Dialogs;

type
  TupEditButon = class(TEdit)
  private
    FButon: TButton;
    function GetMinHeight: Integer;
    procedure SetEditRect;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    function GetOnButonClick: TNotifyEvent;
    procedure SetOnButonClick(const Value: TNotifyEvent);
  protected
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateParams(var Params: TCreateParams); override;
    property Button: TButton read FButon;
  published
    {OnButonClick: Bu özellik butonumuza basılıp basılmadığını yönetecek...}
    Property OnButonClick: TNotifyEvent read GetOnButonClick write SetOnButonClick;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Ugur', [TupEditButon]);
end;

{ TupEditButon }

constructor TupEditButon.Create(AOwner: TComponent);
var
  En: integer;
begin
  {Ana nesneyi oluşturduk}
  inherited Create(AOwner);
  {Butonu üretiyoruz}
  En := 20;
  FButon := TButton.Create (Self);
  with  FButon do begin
        Parent := Self;
        Caption := '...';
        { Buton.Brush.Bitmap.Canvas.TextWidth(FButon.Caption); }
        { Yukarıdaki satır nesne henüz oluşum aşamasında olduğu için hata veriyor }
        { O nedenle "EN" değişkenine sabit bir değer verildi... }
        Height := 16;
        Width := En;
        Left := Self.Width - En - 1;
        Text := ''; {Buraya bir başlangıç değeri verilebilir...}
        Visible := True;
  end;
  ControlStyle := ControlStyle - [csSetCaption];
end;

procedure TupEditButon.CreateParams(var Params: TCreateParams);
begin
  {Bu prosedür bu bileşene bağlı alt bileşenlere parametre göndermekte kullanılır...}
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

procedure TupEditButon.CreateWnd;
begin
  {Yazı alanının belli bir bölgede sınırlanmasına yardım eder...}
  inherited CreateWnd;
  SetEditRect;
end;

destructor TupEditButon.Destroy;
begin
  {Nesne yok edilirken bağlı diğer nesneler de yokedilir.}
  FButon := nil;
  inherited Destroy;
end;

function TupEditButon.GetMinHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  {Metin alanının kaç pizel yükseklikte olduğunu hesaplar.}
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  I := SysMetrics.tmHeight;
  if I > Metrics.tmHeight then I := Metrics.tmHeight;
  Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;

function TupEditButon.GetOnButonClick: TNotifyEvent;
begin
  {Olay tetiklendiğinde bizim butona yönlendirilecek...}
  Result := FButon.OnClick;
end;

procedure TupEditButon.KeyPress(var Key: Char);
begin
  inherited;
  {Enter'e basılınca alt satıra geçmesin, bi düdük çalsın...}
  if Key = #13 then begin
     Key := #0;
     MessageBeep(0);
  end;
  {entere basılmamışsa tuşu devreye al...}
  if not(Key in [#0,#13]) then inherited KeyPress(Key);
end;

procedure TupEditButon.SetEditRect;
var
  Kutu: TRect;
begin
  {yazı alanının belli bir sınır içine alınmasını sağlar...}
  {$IFNDEF TMSDOTNET}
    SendMessage(Handle, EM_GETRECT, 0, LongInt(@Kutu));
  {$ENDIF}
  {$IFDEF TMSDOTNET}
    Perform(EM_GETRECT, 0, Kutu);
  {$ENDIF}
    Kutu.Bottom := ClientHeight + 1;{windowsun paint zımbırtısının bir buguymuş}
    Kutu.Right  := ClientWidth - FButon.Width - 1;
    Kutu.Top    := 0;
    Kutu.Left   := 0;
  {$IFNDEF TMSDOTNET}
    SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Kutu));
    SendMessage(Handle, EM_GETRECT, 0, LongInt(@Kutu));  {dibagçün...}
  {$ENDIF}
  {$IFDEF TMSDOTNET}
    Perform(EM_SETRECTNP, 0, Kutu);
    Perform(EM_GETRECT, 0, Kutu);
  {$ENDIF}
end;

procedure TupEditButon.SetOnButonClick(const Value: TNotifyEvent);
begin
  {Editteki butona basılazak...}
  FButon.OnClick := Value;
end;

procedure TupEditButon.WMSize(var Message: TWMSize);
var
  Boy: Integer;
begin
  inherited;
  Boy := GetMinHeight;
  {Edit nesnesinin bir buguymuş. Bu işlem yapılmazsa nesne büzüşür...}
  if (Height < Boy) then
      Height := Boy
  else
  if (FButon <> nil) then begin
      if NewStyleControls and Ctl3D
      then FButon.SetBounds(Width - FButon.Width - 4, 0, FButon.Width, Height - 4)
      else FButon.SetBounds(Width - FButon.Width, 1, FButon.Width, Height - 2);
      SetEditRect;
  end;
end;

end.

Butonlu Edit Nesnesi (TupEditButon)

TupEditButon ne işe yarar

Hatırlatma

Cıvıltılar

Kategori Bulutu

Etikettekiler

Bağlantılar

Sayfa Seç

Yazı Miktarı