const
defLabelWidth = 400; { default width of label }
{$IFDEF PAIDVERS}
SDLVersionInfo = 'rasterlab_r1210_full';
IsLightEd = false;
{$ELSE}
SDLVersionInfo = 'rasterlab_r1210_lighted';
IsLightEd = true;
{$ENDIF}
Release = 1210;
type
ESDLRasterLabError = class(ESDLError); { exception type to indicate errors }
TRDBlockMode = (rdbmOff, rdbmOn, rdbmRaster);
TRDScrollMode = (rdsmOff, rdsmLeft, rdsmRight, rdsmDown, rdsmUp);
TRDCharMatrix = record { character map, 256 chars, max 32x32 bits per char }
FontWidth : integer;
FontHeight : integer;
LeftMostBit : array [0..255] of byte;
RightMostBit : array [0..255] of byte;
BitData : array [0..255,0..31] of longint;
end;
{$IFDEF GE_LEV29}
[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidWin64x)]
{$ENDIF}
TRasterLab = class (TGraphicControl)
private
FCMat : TRDCharMatrix;
FFrameStyle : TFrameStyle; { style of frame }
FScrollMode : TRDScrollMode;
FScrollPosX : integer;
FScrollPosY : integer;
FScrollLoop : boolean;
FScrTimerHandle : HWND;
FScrTimerEnabled : boolean;
FAutoCenter : boolean;
FTextBitLength : integer;
FOnScrollTimer : TNotifyEvent;
FScrollIv : integer;
FScrollInc : integer;
FLabText : string; { text string to be displayed }
FColorLabBakG : TColor; { color of label background }
FColorDotOn : TColor; { color of label text }
FColorDotOff : TColor; { inactive color of label text }
FColBlackLine : TColor; { colors to draw the frame }
FColGrayLine : TColor; { -"- }
FColWhiteLine : TColor; { -"- }
FAutoHeight : boolean; { TRUE: automatic size adjustment }
FCharBlockMode : TRDBlockMode; { display mode for dark LED dots }
FColorScheme : TColorScheme; { color scheme of frames }
FOnScrLoopRestart: TNotifyEvent;
FProportional : boolean; {TRUE: proportional character display }
FDotSize : integer;
FDotSpacing : integer;
FXPos : integer; { relative position of displayed code }
FYPos : integer;
procedure AdjustAutoHeight;
procedure AdjustAutoCenter;
function CalcTextBitLength (txt: string): integer;
procedure SetColorLabBakG (Value: TColor);
procedure SetColorDotOn (Value: TColor);
procedure SetColorDotOff (Value: TColor);
procedure SetColorScheme (Value: TColorScheme);
procedure SetFrameStyle (value: TFrameStyle);
procedure SetLabText (value: string);
procedure SetCharBlockMode (value: TRDBlockMode);
procedure SetProportional (value: boolean);
procedure SetAutoHeight (value: boolean);
procedure SetAutoCenter (value: boolean);
procedure SetDotSpacing (value: integer);
procedure SetDotSize (value: integer);
procedure SetOnScrollTimer(Value: TNotifyEvent);
procedure SetXPos (value: integer);
procedure SetYPos (value: integer);
procedure SetCharMatrix (value: TRDCharMatrix);
procedure SetScrollMode (value: TRDScrollMode);
procedure SetScrollLoop (value: boolean);
procedure SetScrollIv (value: integer);
procedure SetScrollInc (value: integer);
procedure UpdateTimer;
protected
procedure AssignTo (Dest: TPersistent); override;
procedure MouseMove (Shift: TShiftState; X,Y: integer); override;
procedure ScrollTimerEvent(Sender: TObject);
procedure DoTimer; dynamic;
procedure DoScrLoopRestart; dynamic;
procedure Paint; override;
procedure WndProc(var Msg: TMessage); { virtual method of base class
is hidden deliberately }
procedure FontChanged (Sender: TObject);
procedure PaintString (cv: TCanvas; CMat: TRDCharMatrix;
PosX, PosY: integer; txt: string; DotSize,
DotSpacing: integer; ColorFg, ColorFgIA, ColorBg: TColor;
CharBlocks: TRDBlockMode; Proportional: boolean;
var TextBitLength: integer);
function PaintChar (cv: Tcanvas; CMat: TRDCharMatrix;
PosX, PosY: integer;
c: char; DotSize, DotSpacing: integer; ColorFg, ColorFgIA,
ColorBg: TColor; FixedWidth: boolean): integer;
public
procedure Assign(Source: TPersistent); override;
property CharMatrix: TRDCharMatrix read FCMat write SetCharMatrix;
constructor Create(AOwner: TComponent); override;
function CreateBitFont (Font: TFont): TRDCharMatrix;
destructor Destroy; override;
published
property Align;
property Anchors;
property AutoHeight: boolean read FAutoHeight write SetAutoHeight;
property AutoCenter: boolean read FAutoCenter write SetAutoCenter;
property ColorLabBakG: TColor read FColorLabBakG write SetColorLabBakG;
property ColorDotOn: TColor read FColorDotOn write SetColorDotOn;
property ColorDotOff: TColor read FColorDotOff write SetColorDotOff;
property ColorScheme: TColorScheme
read FColorScheme write SetColorScheme;
property DotSpacing: integer read FDotSpacing write SetDotSpacing;
property DotSize: integer read FDotSize write SetDotSize;
property Font;
property FrameStyle: TFrameStyle read FFrameStyle write SetFrameStyle;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property PosX: integer read FXPos write SetXPos;
property PosY: integer read FYPos write SetYPos;
property Proportional: boolean read FProportional write SetProportional;
property ScrollMode: TRDScrollMode read FScrollMode write SetScrollMode;
property ScrollInterval: integer read FScrollIv write SetScrollIv;
property ScrollIncrement: integer read FScrollInc write SetScrollInc;
property ScrollLoop: boolean read FScrollLoop write SetScrollLoop;
property CharBlockMode: TRDBlockMode
read FCharBlockMode write SetCharBlockMode;
property ShowHint;
{$IFDEF GE_LEV17}
(**) property StyleElements;
{$ENDIF}
property Text: string read FLabText write SetLabText;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseMove;
property OnMouseDown;
property OnMouseUp;
property OnScrollTimer: TNotifyEvent
read FOnScrollTimer write SetOnScrollTimer;
property OnScrollLoopRestart: TNotifyEvent
read FOnScrLoopRestart write FOnScrLoopRestart;
end;
|