txbutton.pas

Special picture button, easy configure... release. You only need one picture for pressed and one for

unit TXButton;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, JclGraphics, JclLogic;

type

  TTButton = class(TCustomControl)
  private
    FCaption : TCaption;
    FActive  : Boolean;
    FDowned  : Boolean;
    FFont    : TFont;
    FFocused : Boolean;
    FModalResult : TModalResult;
    FHotKey  : Char;
    FCancel  : Boolean;
    FDefault : Boolean;

    FOnClick : TNotifyEvent;
    FOnEnter : TNotifyEvent;
    FOnExit  : TNotifyEvent;
    FOnKeyDown : TKeyEvent;
    FOnKeyUp : TKeyEvent;
    FOnKeyPress : TKeyPressEvent;

    { Slike }
    FImgNSel : TPicture;
    FImgSel : TPicture;

    FDrawImgNEna : TBitmap;    
    FDrawImgNSel : TBitmap;
    FDrawImgSel : TBitmap;

    { Da li je startovan }
    FExecuted : Boolean;

    procedure SetCaption (ACaption : TCaption);
    function  GetCaption : TCaption;

{    procedure SetDowned (ADowned : Boolean);
    function  GetDowned : Boolean;
}
    procedure SetFont (AFont : TFont);
    function  GetFont : TFont;

    procedure SetModalResult (AModalResult : TModalResult);
    function  GetModalResult : TModalResult;

    procedure FOnButtonClick;

  protected
    procedure Paint; override;
    procedure MouseEnter (var Message : TMessage); message CM_MOUSEENTER;
    procedure MouseLeave (var Message : TMessage); message CM_MOUSELEAVE;

    procedure LMouseDown  (var Message : TMessage); message WM_LBUTTONDOWN;
{
    procedure RMouseDown  (var Message : TMessage); message WM_RBUTTONDOWN;
}
    procedure LMouseUp  (var Message : TMessage); message WM_LBUTTONUP;
{
    procedure RMouseUp  (var Message : TMessage); message WM_RBUTTONUP;
}
    procedure LMouseDblClick  (var Message : TMessage); message WM_LBUTTONDBLCLK;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMLostFocus); message CM_EXIT;

    procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;

    procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;
    procedure WMKeyUp(var Message: TMessage); message WM_KEYUP;

    procedure CMDialogChar(var Message : TCMDialogChar);  message CM_DIALOGCHAR;
    procedure CMDialogKey(var Message : TCMDialogKey);  message CM_DIALOGKEY;

    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;

    procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;

    Procedure SetImgNSel(Pic:TPicture);
    Procedure SetImgSel(Pic:TPicture);

    
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;

    Procedure ImageResize;
    { Morhing }
{    procedure Blendit(bFr,bTo,bLn : Pointer ; Width,Height : Integer ; Dens : LongInt);
    procedure Blend;
}
  published
    property Caption : TCaption read GetCaption write SetCaption;
    property Font : TFont read GetFont write SetFont;
    property Enabled;
    property ParentFont;
    property Hint;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Cancel : Boolean read FCancel write FCancel default False;
    property Default : Boolean read FDefault write FDefault default False;
    property ModalResult : TModalResult read GetModalResult write SetModalResult default mrNone;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
    property ImageNSel: TPicture read FImgNSel write SetImgNSel;
    property ImageSel: TPicture read FImgSel write SetImgSel;
  end;

procedure Register;

implementation
{
Var
  EBX, ESI, EDI, ESP, EBP,
  FinA,
  Dens1, Dens2 : Longint;
}

constructor TTButton.Create (AOwner : TComponent);
begin
  Inherited Create (AOwner);
  Width := 75;
  Height := 25;
  FFont := TFont.Create;
  FCaption := 'XtraButton';
  FActive := False;
  FDowned := False;
  FFocused := False;
  TabStop := True;

  FImgNSel := TPicture.Create;
  FImgSel := TPicture.Create;

  FDrawImgNSel := TBitmap.Create;
  FDrawImgNEna := TBitmap.Create;  
  FDrawImgSel := TBitmap.Create;

  { StartUp Button }
{  FDrawImgNSel.Width := 4;
  FDrawImgNSel.Height := 4;
{  FDrawImgNSel.Canvas.Pen.Color := clBlue;
  FDrawImgNSel.Canvas.Rectangle(0,0,3,3);
  FImgNSel.Bitmap.Assign(FDrawImgNSel);
  FDrawImgNSel.Canvas.Pen.Color := clBlue;
  FDrawImgNSel.Canvas.Rectangle(1,1,4,4);
  FImgSel.Bitmap.Assign(FDrawImgNSel);

  FDrawImgNSel.FreeImage;
}
  FExecuted := False;
  Enabled := True;
end;

destructor TTButton.Destroy;
begin

  FImgNSel.Free;
  FImgSel.Free;

  FDrawImgNSel.Free;
  FDrawImgNEna.Free;
  FDrawImgSel.Free;

  FFont.Free;
  inherited;
end;

procedure TTButton.CMDialogKey(var Message : TCMDialogKey);
begin
  if Enabled and  ((FCancel and (Message.CharCode = VK_ESCAPE)) or
  (FDefault and (Message.CharCode = VK_RETURN))) then
    FOnButtonClick;
end;


procedure Grayscale(const Bmp: TBitmap);
 {From: Pascal Enz, [e-mail] }
type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;
var
  x, y, Gray: Integer;
  Row: PRGBArray;
begin
  Bmp.PixelFormat := pf24Bit;
  for y := 0 to Bmp.Height - 1 do
  begin
    Row := Bmp.ScanLine[y];
    for x := 0 to Bmp.Width - 1 do
    begin
      Gray := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
      Row[x].rgbtRed := Gray;
      Row[x].rgbtGreen := Gray;
      Row[x].rgbtBlue := Gray;
    end;
  end;
end;

{procedure Antialising(C: TCanvas; Rect: TRect; Percent: Integer);
var
  l, p: Integer;
  R, G, B: Integer;
  R1, R2, G1, G2, B1, B2: Byte;
begin
  with c do
  begin
    Brush.Style := bsclear;
{    lineto(200, 100);
    moveto(50, 150);
    Ellipse(50, 150, 200, 30);}
{    for l := Rect.Top to Rect.Bottom do
    begin
      for p := Rect.Left to Rect.Right do
      begin
        R1 := GetRValue(Pixels[p, l]);
        G1 := GetGValue(Pixels[p, l]);
        B1 := GetBValue(Pixels[p, l]);


        //Pixel links
        //Pixel left
        R2 := GetRValue(Pixels[p - 1, l]);
        G2 := GetGValue(Pixels[p - 1, l]);
        B2 := GetBValue(Pixels[p - 1, l]);

        if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
        begin
          R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
          G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
          B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
          Pixels[p - 1, l] := RGB(R, G, B);
        end;

        //Pixel rechts
        //Pixel right
        R2 := GetRValue(Pixels[p + 1, l]);
        G2 := GetGValue(Pixels[p + 1, l]);
        B2 := GetBValue(Pixels[p + 1, l]);

        if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
        begin
          R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
          G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
          B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
          Pixels[p + 1, l] := RGB(R, G, B);
        end;

        //Pixel oben
        //Pixel up
        R2 := GetRValue(Pixels[p, l - 1]);
        G2 := GetGValue(Pixels[p, l - 1]);
        B2 := GetBValue(Pixels[p, l - 1]);

        if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
        begin
          R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
          G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
          B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
          Pixels[p, l - 1] := RGB(R, G, B);
        end;

        //Pixel unten
        //Pixel down
        R2 := GetRValue(Pixels[p, l + 1]);
        G2 := GetGValue(Pixels[p, l + 1]);
        B2 := GetBValue(Pixels[p, l + 1]);

        if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
        begin
          R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
          G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
          B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
          Pixels[p, l + 1] := RGB(R, G, B);
        end;
      end;
    end;
  end;
end;
}

procedure AntiAliasing(clip: tbitmap; XOrigin, YOrigin,
  XFinal, YFinal: Integer);
var Memo,x,y: Integer; (* Composantes primaires des points environnants *)
    p0,p1,p2:pbytearray;
begin
   if XFinal<XOrigin then begin Memo:=XOrigin; XOrigin:=XFinal; XFinal:=Memo; end;  (* Inversion des valeurs   *)
   if YFinal<YOrigin then begin Memo:=YOrigin; YOrigin:=YFinal; YFinal:=Memo; end;  (* si diff俽ence n俫ative*)
   XOrigin:=max(1,XOrigin);
   YOrigin:=max(1,YOrigin);
   XFinal:=min(clip.width-2,XFinal);
   YFinal:=min(clip.height-2,YFinal);
   clip.PixelFormat :=pf24bit;
   for y := YOrigin to YFinal do begin
    p0:=clip.ScanLine [y-1];
    p1:=clip.ScanLine [y];
    p2:=clip.ScanLine [y+1];
    for x := XOrigin to XFinal do
        Begin
          p1[x*3] := (p0[x*3]+p2[x*3]+p1[x*3]*4) div 6;
          p1[x*3+1] := (p0[x*3+1]+p2[x*3+1]+p1[x*3+1]*4) div 6;
          p1[x*3+2] := (p0[x*3+2]+p2[x*3+2]+p1[x*3+2]*4) div 6;
        end;
   end;
end;


Procedure TTButton.ImageResize;
var
    W, H, T : Integer;
    tR, tR1 : TRect;
    tBMP : TBitmap;

    AText : String;
  
Begin

      AText := FCaption;
      If Pos ('&', FCaption) <> 0 then Delete (AText, Pos ('&', AText), 1);


        W := FImgSel.Width;
        H := FImgSel.Height;

        tBMP := TBitmap.Create;
        tBMP.Assign( FImgSel.Graphic );

        FDrawImgSel.Width := Width;
        FDrawImgSel.Height := Height;

        FDrawImgSel.Canvas.CopyMode := cmSrcCopy;

        { Pocetak Gore Levo }
        { Source }
        tR.Top := 0;
        tR.Bottom := H;
        tR.Left := 0;
        tR.Right := W;

        { Destinaction }
        tR1 := tR;

        FDrawImgSel.Canvas.CopyRect(tR1, tBMP.Canvas, tR);

        { Dole Levo }
        { Source }
        tR.Top := Trunc(H/2);
        tR.Bottom := H;
        tR.Left := 0;
        tR.Right := W;

        { Destinaction }
        tR1.Top := Height+tR.Top-tR.Bottom;
        tR1.Bottom := Height;
        tR1.Left := 0;
        tR1.Right := W;

        FDrawImgSel.Canvas.CopyRect(tR1, FDrawImgSel.Canvas, tR);

        { Levo razvlacenje }
        { Source }
        tR.Top := Trunc(H/2)-1;
        tR.Bottom := Trunc(H/2);
        tR.Left := 0;
        tR.Right := W;

        For T := Trunc(H/2)-1 to Height-Trunc(H/2) Do
        Begin
            { Destinaction }
            tR1.Top := T;
            tR1.Bottom := T+1;
            tR1.Left := 0;
            tR1.Right := W;

            FDrawImgSel.Canvas.CopyRect(tR1, FDrawImgSel.Canvas, tR);
        End;

        { Desna Ivica }
        { Source }
        tR.Top := 0;
        tR.Bottom := Height;
        tR.Left := Trunc(W/2);
        tR.Right := W;

        { Destinaction }
        tR1.Top := 0;
        tR1.Bottom := Height;
        tR1.Left := Width+tR.Left-tR.Right;
        tR1.Right := Width;

        FDrawImgSel.Canvas.CopyRect(tR1, FDrawImgSel.Canvas, tR);

        { Desno razvlacenje }
        { Source }
        tR.Top := 0;
        tR.Bottom := Height;
        tR.Left := Trunc(W/2)-1;
        tR.Right := Trunc(W/2);

        For T := Trunc(W/2)-1 to Width-Trunc(W/2) do
        Begin
            { Destinaction }
            tR1.Top := 0;
            tR1.Bottom := Height;
            tR1.Left := T;
            tR1.Right := T+1;

            FDrawImgSel.Canvas.CopyRect(tR1, FDrawImgSel.Canvas, tR);
        End;

         { Caption }
        FDrawImgSel.Canvas.Font := FFont;
        FDrawImgSel.Canvas.Brush.Style := bsClear;        
        FDrawImgSel.Canvas.TextRect (Rect (4, 4, Width-4, Height-4),
          (Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2 + Integer (FDowned),
          (Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2 + Integer (FDowned), AText);

          If Pos ('&', FCaption) <> 0 then
          begin
            FDrawImgSel.Canvas.Pen.Color := FDrawImgSel.Canvas.Font.Color;
            FDrawImgSel.Canvas.Pen.Width := 1;
            FDrawImgSel.Canvas.MoveTo (((Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2) + FDrawImgSel.Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption)-1)) + Integer (FDowned),
                           ((Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2) + FDrawImgSel.Canvas.TextHeight (AText) + Integer (FDowned));
            FDrawImgSel.Canvas.LineTo (((Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2) + FDrawImgSel.Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption))) + Integer (FDowned),
                           ((Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2) + FDrawImgSel.Canvas.TextHeight (AText) + Integer (FDowned));
          end;

        Antialiasing(FDrawImgSel, (Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2,
            (Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2,
            Width-((Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2),
            Height-((Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2 ) );

        { ****** Not Sel ******** }

        tBMP.FreeImage;
        tBMP.Assign( FImgNSel.Graphic );

        FDrawImgNSel.Width := Width;
        FDrawImgNSel.Height := Height;

        FDrawImgNSel.Canvas.CopyMode := cmSrcCopy;

        { Pocetak Gore Levo }
        { Source }
        tR.Top := 0;
        tR.Bottom := H;
        tR.Left := 0;
        tR.Right := W;

        { Destinaction }
        tR1 := tR;

        FDrawImgNSel.Canvas.CopyRect(tR1, tBMP.Canvas, tR);

        { Dole Levo }
        { Source }
        tR.Top := Trunc(H/2);
        tR.Bottom := H;
        tR.Left := 0;
        tR.Right := W;

        { Destinaction }
        tR1.Top := Height+tR.Top-tR.Bottom;
        tR1.Bottom := Height;
        tR1.Left := 0;
        tR1.Right := W;

        FDrawImgNSel.Canvas.CopyRect(tR1, FDrawImgNSel.Canvas, tR);

        { Levo razvlacenje }
        { Source }
        tR.Top := Trunc(H/2)-1;
        tR.Bottom := Trunc(H/2);