STCPAL

Top  Previous  Next

{ StellaMAP komponens készlet:

 

TStColorPal

-----------

StellaMap komponens előtér(pont) és háttérszín(térkép alapszín)  definiáló

színskála panel egy TColorGrid és két TShape komponenssel.

Ball click  = pont szín

Jobb click  = alapszín

click a TShape-re = TColorDialog színskála a háttérszín beállításához

}

unit stCPal;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs, ExtCtrls, StMap16w, StMap16, ColorGrd;

 

type

TPosition = (poLeft,poRight);

 

TStColorPal = class(TPanel)

private

  FStellaMapSource : TStMapW;

  FPosition : TPosition;

  FCG  : TColorGrid;

  FTS1 : TShape;

  FTS2 : TShape;

  FColorChange:TNotifyEvent;

  FForegroundColor:TColor;

  FBackgroundColor:TColor;

  FShapes: TShapeType;

  FGridOrdering: TGridOrdering;

  FGridCtl3d : boolean;

  FShapesVisible : boolean;

  procedure SetPosition(Value:TPosition);

  procedure SetOnColorChange(Sender:TObject);virtual;

  procedure SetForegroundColor(Value:TColor);

  procedure SetBackgroundColor(Value:TColor);

  function  GetForegroundColor:TColor;

  function  GetBackgroundColor:TColor;

  procedure SetShapes(Value:TShapeType);

  procedure SetGridOrdering(Value:TGridOrdering);

  procedure SetShapesVisible(Value: boolean);

  procedure SetGridCtl3d(Value: boolean);

protected

  procedure Resize; override;

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

  procedure MDown(Sender:TObject;Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

  procedure Notification(AComponent: TComponent;

    Operation: TOperation); override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  property CG : TColorGrid read FCG write FCG;

  property TS1 : TShape read FTS1 write FTS1;

  property TS2 : TShape read FTS2 write FTS2;

  procedure DblClick; override;

  procedure SzinBeallit;

published

  Property StellaMapSource : TStMapW read FStellaMapSource write FStellaMapSource;

  Property Position : TPosition read FPosition write SetPosition ;

  property ForegroundColor:TColor read GetForegroundColor write SetForegroundColor;

  property BackgroundColor:TColor read GetBackgroundColor write SetBackgroundColor;

  property Shapes: TShapeType read FShapes write SetShapes;

  property GridOrdering: TGridOrdering read FGridOrdering write SetGridOrdering

                         default go8x2;

  property ShapesVisible : boolean read FShapesVisible write SetShapesVisible;

  Property OnColorChange:TNotifyEvent read FColorChange write FColorChange;

  Property GridCtl3d : boolean read FGridCtl3d write SetGridCtl3d;

  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;

 

Var StColorPal : TStColorPal;

 

implementation

 

 

constructor TStColorPal.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   CG := TColorGrid.Create(Self);

   CG.Parent:=Self;

   CG.GridOrdering := go8x2;

   CG.Ctl3D := False;

   CG.Visible := True;

   CG.Enabled := True;

   CG.Name := 'CG';

   CG.OnChange := SetOnColorChange;

   TS1 := TShape.Create(Self);

   TS2 := TShape.Create(Self);

   TS1.Parent:=Self;

   TS2.Parent:=Self;

   TS1.Name := 'TS1';

   TS2.Name := 'TS2';

   FShapesVisible:=True;

   TS1.OnMouseDown:=MDown;

   TS2.OnMouseDown:=MDown;

   Width := 200; Height := 42;

   FPosition := poRight;

   FGridOrdering := go8x2;

   FGridCtl3d    := False;

end;

 

destructor TStColorPal.Destroy;

begin

   CG.Free; TS1.Free; TS2.Free;

   inherited Destroy;

end;

 

 

procedure TStColorPal.SetPosition(Value:TPosition);

begin

   FPosition := Value;

   If ShapesVisible then begin

      TS1.Width:=20; TS1.Height:=(Height-2*BevelWidth-4) div 2;

      TS1.Top:=BevelWidth+2;

      TS2.Width:=20; TS2.Height:=(Height-2*BevelWidth-4) div 2;

      TS2.Top:=BevelWidth+TS1.Height+2;

      CG.Width:=Width-2*BevelWidth-TS1.Width-10;

   end else

       CG.Width:=Width-2*BevelWidth-4;

   CG.Height:=TS2.Top+TS2.Height-TS1.Top;

   CG.Top:=(Height-CG.Height) div 2;

   Case Value of

   poLeft : begin

            CG.Left:=BevelWidth;

            TS1.Left:=Width-TS1.Width-8;

            TS2.Left:=Width-TS2.Width-8;

            end;

   poRight: begin

            CG.Left:=Width-BevelWidth-CG.Width-4;

            TS1.Left:=BevelWidth+4;

            TS2.Left:=BevelWidth+4;

            end;

   end;

end;

 

procedure TStColorPal.Resize;

begin

 Position:=FPosition;

 Inherited Resize;

end;

 

procedure TStColorPal.DblClick;

begin

 Szinbeallit;

 Inherited DblClick;

end;

 

procedure TStColorPal.MDown(Sender:TObject;Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

begin

Szinbeallit;

end;

 

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

    X, Y: Integer);

begin

Szinbeallit;

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

end;

 

procedure TStColorPal.SzinBeallit;

var cd: TColorDialog;

begin

Try

 cd:=TColorDialog.Create(Self);

 cd.Color:=BackgroundColor;

 If cd.Execute then BackgroundColor:=cd.Color;

Finally

 cd.free;

end;

Inherited DblClick;

end;

 

procedure TStColorPal.SetOnColorChange(Sender:TObject);

begin

   BackgroundColor := CG.BackgroundColor;

   ForegroundColor := CG.ForegroundColor;

end;

 

procedure TStColorPal.SetForegroundColor(Value:TColor);

begin

  FForegroundColor:=Value;

  If StellaMapSource<>nil then StellaMapSource.Pontszin := FForegroundColor;

  TS1.Brush.Color:=FForegroundColor;

end;

 

procedure TStColorPal.SetBackgroundColor(Value:TColor);

begin

  FBackgroundColor:=Value;

  If StellaMapSource<>nil then StellaMapSource.Alapszin := FBackgroundColor;

  TS2.Brush.Color:=FBackgroundColor;

end;

 

function  TStColorPal.GetForegroundColor:TColor;

begin

If StellaMapSource<>nil then Result:=StellaMapSource.Pontszin

else Result:=CG.ForegroundColor;

end;

 

function  TStColorPal.GetBackgroundColor:TColor;

begin

If StellaMapSource<>nil then Result:=StellaMapSource.Alapszin

else Result:=CG.BackgroundColor;

end;

 

procedure TStColorPal.SetShapes(Value:TShapeType);

begin

FShapes:=Value;

TS1.Shape:=Value;

TS2.Shape:=Value;

invalidate;

end;

 

 

procedure TStColorPal.SetGridOrdering(Value:TGridOrdering);

begin

FGridOrdering:=Value;

CG.GridOrdering:=Value;

Resize;

end;

 

procedure TStColorPal.SetShapesVisible(Value: boolean);

begin

If FShapesVisible <> Value then begin

   FShapesVisible := Value;

   TS1.Visible := Value; TS2.Visible := Value;

   Resize;

end;

end;

 

procedure TStColorPal.SetGridCtl3d(Value: boolean);

begin

If FGridCtl3d <> Value then begin

   FGridCtl3d := Value;

   CG.Ctl3d := Value;

   Resize;

end;

end;

 

procedure TStColorPal.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (AComponent = StellaMapSource)

then StellaMapSource := nil;

end;

 

end.