Center Scroll Tekst

prøv det her :

Jeg har ænderet i constructoren, og inført endnu en privat variabel. er udover er der ænderet i paint.

unit Unit2;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms, extctrls, Sysutils;

type
  TJScrollText = class(TObject)
  private
    FOffset: integer;
    FBackGround: TColor;
    FClientRect: TRect;
    FControl: TWinControl;
    FTextHeight: Integer;
    FTextColor: TColor;
    FBrush: TBrush;
    FBuffer: TStringList;
    FMoveable: Boolean;
    OrginalWindProc: TWndMethod;
    FSpeed: Integer;
    _TextHeight : Integer;
    PAINTSTRUCT : TPAINTSTRUCT;
  protected
    procedure CalculateSize;
    procedure Draw;
    procedure Reset;
    procedure SetBackGround(const Value: TColor);
    procedure SetMoveable(const Value: Boolean);
    procedure SetSpeed(const Value: Integer);
    procedure SetTextColor(const Value: TColor);
    procedure WndProc(var Message: TMessage);
    function TextExtent(const Text: PChar): TSize;
    function TextHeight(const Text: PChar): Integer;
    function TextWidth(const Text: PChar): Integer;
  public
    constructor Create(WinControl: TWinControl);
    destructor Destroy; override;

    procedure Assign(Source: TPersistent);
    procedure LoadFromFile(const FileName: string);

    property BackGround: TColor write SetBackGround;
    property Moveable: Boolean read FMoveable write SetMoveable;
    property Speed : Integer read FSpeed write SetSpeed;
    property TextColor: TColor write SetTextColor;
  end;

implementation

constructor TJScrollText.Create(WinControl: TWinControl);
begin
  inherited Create;
  FBuffer := TStringList.Create;
  FMoveable := false;
  fControl := WinControl;
  OrginalWindProc := fControl.WindowProc;
  fControl.WindowProc := WndProc;
  GetClientRect(fControl.Handle, FClientRect);
  Speed := 40;
  FBrush := TBrush.Create;
  _TextHeight := TextHeight(\'Wg\');
  Reset;
end;

destructor TJScrollText.Destroy;
begin
  FBuffer.free;
  KillTimer(fControl.Handle, 1);
  inherited;
end;

procedure TJScrollText.Draw;
var
  i,j: Integer;
  s: Pchar;
  aDC: HDC;
  TextRect : TRect;
begin
  BeginPaint(fControl.Handle,PAINTSTRUCT);

  GetClientRect(fControl.Handle, FClientRect);
  aDC := GetDc(fControl.Handle);
  fillRect(aDC, FClientRect, FBackGround);

  SetBkMode(aDC, Transparent);
  Windows.SetTextColor(aDC, FTextColor);

  j:= FBuffer.Count - 1;
  for i := 0 to j do
  begin
    s := Pointer(FBuffer.Strings[i]);
    TextRect := FClientRect;
    TextRect.Top := i * 20 + fOffset;
    TextRect.Bottom := TextRect.Top +  _TextHeight;

    DrawText(aDC,s,-1, TextRect, DT_CENTER);
  end;

  ReleaseDC(fControl.Handle, aDC);
  Dec(fOffset);

  if fTextHeight + fOffset <= 0 then
    Reset;

  EndPaint(fControl.Handle,PAINTSTRUCT);
end;

procedure TJScrollText.LoadFromFile(const FileName: string);
begin
  FBuffer.LoadFromFile(FileName);
  CalculateSize;
end;

procedure TJScrollText.Assign(Source: TPersistent);
begin
  FBuffer.Assign(Source);
  CalculateSize;
end;

procedure TJScrollText.Reset;
var
  aDc: HDC;
begin
  aDC := GetDc(fControl.Handle);
  GetClientRect(fControl.Handle, FClientRect);
  fOffset := FClientRect.Bottom - FClientRect.Top;
  FillRect(aDC, FClientRect, FBackGround);
  ReleaseDC(fControl.Handle, aDC);
end;

procedure TJScrollText.SetBackGround(const Value: TColor);
begin
  FBackGround := CreateSolidBrush(Value);
  TPanel(fControl).Color := Value;
end;

procedure TJScrollText.SetTextColor(const Value: TColor);
begin
  FTextColor := Value;
end;

procedure TJScrollText.CalculateSize;
var
  Size: TSize;
  aDc: HDC;
begin
  aDC := GetDc(fControl.Handle);
  GetTextExtentPoint32(aDC, \'Wg\', 2, Size);
  ReleaseDC(fControl.Handle, aDC);
  fTextHeight := Size.cy * FBuffer.Count + FClientRect.Bottom - FClientRect.Top;
end;

procedure TJScrollText.SetMoveable(const Value: Boolean);
begin
  FMoveable := Value;
end;

procedure TJScrollText.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_TIMER:
      Draw;
    WM_LBUTTONDOWN:
      begin
        if not FMoveable then
          exit;
        ReleaseCapture;
        fControl.Perform(WM_SysCommand, $F012, 0);
        exit;
      end;
  end;
  OrginalWindProc(Message);
end;

procedure TJScrollText.SetSpeed(const Value: Integer);
begin
  FSpeed := Value;
  KillTimer(fControl.Handle, 1);
  SetTimer(fControl.Handle, 1, FSpeed, nil);
end;

function TJScrollText.TextExtent(const Text: PChar): TSize;
var
  aDc: HDC;
begin
  aDC := GetDc(fControl.Handle);
  Result.cX := 0;
  Result.cY := 0;
  Windows.GetTextExtentPoint32(aDC, Text, StrLen(Text), Result);
end;

function TJScrollText.TextHeight(const Text: PChar): Integer;
begin
  Result := TextExtent(Text).cy;
end;

function TJScrollText.TextWidth(const Text: PChar): Integer;
begin
  Result := TextExtent(Text).cx;
end;

end.


Jens B.
Http://fotx.net/borrisholt

Skift denne ud med Windows API\'et

TextOut ( aDC, 0, i*20+fOffset, PChar ( s ) , length ( s ) );

DrawText()

Den kan skrive teksten højre venstre og center stillet.

/Martin