CHIMAGE

Top  Previous  Next

unit Chimage;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs,stdctrls;

 

type

 

TPointType = class(TPersistent)

public

  FOnChange: TNotifyEvent;

  Fx : integer;

  Fy : integer;

  procedure Setx(Value:integer);

  procedure Sety(Value:integer);

  procedure Changed; dynamic;

published

  property OnChange: TNotifyEvent read FOnChange write FOnChange;

  property x: integer read Fx write Setx;

  property y: integer read Fy write Sety;

end;

 

TCharImage = class(TCustomControl)

private

  FText : string;

  FTextPosition : TPointType;

  FFont : TFont;

  procedure SetText(Value:string);

  procedure SetFont(Value:TFont);

protected

  procedure Paint;override;

  procedure Change(Sender: TObject);

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  Property Font : TFont read FFont write SetFont ;

  Property Text : string read FText write SetText ;

  Property TextPosition : TPointType read FTextPosition write FTextPosition;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TCharImage]);

end;

 

{ -----------  TPointType --------- }

procedure TPointType.Changed;

begin if Assigned(FOnChange) then FOnChange(Self); end;

 

procedure TPointType.Setx(Value:integer);

begin

If Fx<>Value then begin

   Fx:=Value;

   Changed;

end;

end;

 

procedure TPointType.Sety(Value:integer);

begin

If Fy<>Value then begin

   Fy:=Value;

   Changed;

end;

end;

 

constructor TCharImage.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   fFont:=TFont.Create;

   FTextPosition := TPointType.Create;

   FTextPosition.OnChange := Change;

   Height := 200;

   Width  := 200;

end;

 

destructor TCharImage.Destroy;

begin

   fFont.Free;

   FTextPosition.Free;

   inherited Destroy;

end;

 

procedure TCharImage.Change(Sender: TObject);

begin

invalidate;

end;

 

procedure TCharImage.SetText(Value:string);

begin

If FText<>Value then begin

   FText:=Value;

   invalidate;

end;

end;

 

procedure TCharImage.SetFont(Value:TFont);

begin

fFont.Assign(Value);

invalidate;

end;

 

procedure TCharImage.Paint;

begin

Canvas.Font.Assign(Font);

Canvas.TextOut(TextPosition.x,Height-TextPosition.y-Canvas.TextHeight(Text),Text);

end;

 

end.

 

.