BRUSHPAL

Top  Previous  Next

unit Brushpal;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, ExtCtrls;

 

type

TBrushStylePalette = class(TCustomControl)

private

  FPen          : TPen;

  FBrush        : TBrush;

  FColor        : TColor;

  FOnChange     : TNotifyEvent;

  FBrushIndex   : integer;

  FOldBrushIndex: integer;

  procedure SetPen(Value: TPen);

  procedure SetBrush(Value: TBrush);

  procedure SetBrushIndex(Value: integer);

  procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;

protected

  Procedure Paint;override;

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

  procedure SetColor(Value: TColor);

  procedure Change; dynamic;

  function ActualRgn(x: integer):integer;

  procedure InvRgn(index: integer);

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  property Align;

  property Ctl3D;

  property DragCursor;

  property DragMode;

  property Enabled;

  property Hint;

  property ParentCtl3D;

  property ParentShowHint;

  property BrushIndex: integer read FBrushIndex write SetBrushIndex;

  property Color :TColor read FColor write SetColor default clWhite;

  property OnChange: TNotifyEvent read FOnChange write FOnChange;

  Property Pen : TPen read FPen write SetPen;

  Property Brush : TBrush read FBrush write SetBrush;

  property Width default 150;

  property Height default 20;

  Property OnDblClick;

  property OnClick;

  property OnDragDrop;

  property OnDragOver;

  property OnEndDrag;

  property OnEnter;

  property OnExit;

  property OnKeyDown;

  property OnKeyPress;

  property OnKeyUp;

  Property OnMouseDown;

  Property OnMouseMove;

  Property OnMouseUp;

end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

RegisterComponents('AL', [TBrushStylePalette]);

end;

 

constructor TBrushStylePalette.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   FPen:=TPen.Create;

   FBrush:=TBrush.Create;

   FOldBrushIndex:=0;

   FBrushIndex   :=0;

   Color:=clWhite;

   Height := 20;

   Width := 150;

end;

 

destructor TBrushStylePalette.Destroy;

begin

   FPen.Free;

   FBrush.Free;

   inherited Destroy;

end;

 

procedure TBrushStylePalette.SetPen(Value:TPen);

begin

FPen.Assign(Value);

Invalidate;

end;

 

procedure TBrushStylePalette.SetBrush(Value: TBrush);

begin

FBrush.Assign(Value);

Invalidate;

end;

 

procedure TBrushStylePalette.SetColor(Value: TColor);

begin

FColor:=Value;

Invalidate;

end;

 

Procedure TBrushStylePalette.Paint;

var i: integer;

begin

With Canvas do begin

  Pen.Style := psSolid;

  Pen.Color := clBlack;

  Pen.Mode  := pmBlack;

  Brush.Color:= Color;

  FillRect(ClientRect);

  For i:=0 to 7 do begin

    Brush.Style := TBrushStyle(i);

    Rectangle((i*width) div 8,0,((i+1)*width) div 8,height);

  end;

end;

inherited Paint;

end;

 

procedure TBrushStylePalette.Change;

begin

if Assigned(FOnChange) then FOnChange(Self);

end;

 

procedure TBrushStylePalette.MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

begin

BrushIndex:=ActualRgn(x);

Change;

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

end;

 

procedure TBrushStylePalette.MouseMove(Shift: TShiftState; X, Y: Integer);

begin

inherited MouseMove(Shift, X, Y);

end;

 

procedure TBrushStylePalette.MouseUp(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

begin

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

end;

 

procedure TBrushStylePalette.CMCtl3DChanged(var Message: TMessage);

begin

inherited;

Invalidate;

end;

 

{ Cursor pozicióból a kis paletta ablak indexét adja}

function TBrushStylePalette.ActualRgn(x: integer):integer;

begin

Result := x div (width div 8);

end;

 

procedure TBrushStylePalette.InvRgn(index: integer);

var rgn: Hrgn;

begin

rgn:= CreateRectRgn((index*width) div 8,0,((index+1)*width) div 8,height);

InvertRgn(Canvas.Handle,rgn);

DeleteObject(rgn);

end;

 

procedure TBrushStylePalette.SetBrushIndex(Value: integer);

begin

FOldBrushIndex:= FBrushIndex;

InvRgn(FOldBrushIndex);

FBrushIndex := Value mod 8;

InvRgn(FBrushIndex);

end;

 

end.