Home: Code Repository: Mastering Delphi 5

Project SIDETEXT

Project Structure

SIDETEXT.DPR
SIDETXTF.PAS
SIDETXTF.DFM

program SideText;

uses
  Forms,
  SideTxtF in 'SideTxtF.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit SideTxtF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormPaint(Sender: TObject);
var
  ALogFont: TLogFont;
  hFont: THandle;
begin
  ALogFont.lfHeight := Font.Height;
  ALogFont.lfWidth := 0;
  ALogFont.lfEscapement := 900;
  ALogFont.lfOrientation := 900;
  ALogFont.lfWeight := fw_DemiBold;
  ALogFont.lfItalic := 0; // false
  ALogFont.lfUnderline := 0; // false
  ALogFont.lfStrikeOut := 0; // false
  ALogFont.lfCharSet := Ansi_CharSet;
  ALogFont.lfOutPrecision := Out_Default_Precis;
  ALogFont.lfClipPrecision := Clip_Default_Precis;
  ALogFont.lfQuality := Default_Quality;
  ALogFont.lfPitchAndFamily := Default_Pitch;
  StrCopy (ALogFont.lfFaceName, PChar (Font.Name));
  hFont := CreateFontIndirect (ALogFont);
  Canvas.Font.Handle := hFont;
  Canvas.TextOut (0, ClientHeight, 'Hello');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ALogFont: TLogFont;
  hFont: THandle;
begin
  ALogFont.lfHeight := Font.Height;
  ALogFont.lfWidth := 0;
  ALogFont.lfEscapement := -450;
  ALogFont.lfOrientation := -450;
  ALogFont.lfWeight := fw_DemiBold;
  ALogFont.lfItalic := 0; // false
  ALogFont.lfUnderline := 0; // false
  ALogFont.lfStrikeOut := 0; // false
  ALogFont.lfCharSet := Ansi_CharSet;
  ALogFont.lfOutPrecision := Out_Default_Precis;
  ALogFont.lfClipPrecision := Clip_Default_Precis;
  ALogFont.lfQuality := Default_Quality;
  ALogFont.lfPitchAndFamily := Default_Pitch;
  StrCopy (ALogFont.lfFaceName, PChar (Font.Name));
  hFont := CreateFontIndirect (ALogFont);
  Font.Handle := hFont;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ALogFont: TLogFont;
  hFont: THandle;
begin
  ALogFont.lfHeight := Font.Height;
  ALogFont.lfWidth := 0;
  ALogFont.lfEscapement := - (GetTickCount div 10) mod 3600;
  ALogFont.lfOrientation := ALogFont.lfEscapement;
  ALogFont.lfWeight := fw_DemiBold;
  ALogFont.lfItalic := 0; // false
  ALogFont.lfUnderline := 0; // false
  ALogFont.lfStrikeOut := 0; // false
  ALogFont.lfCharSet := Ansi_CharSet;
  ALogFont.lfOutPrecision := Out_Default_Precis;
  ALogFont.lfClipPrecision := Clip_Default_Precis;
  ALogFont.lfQuality := Default_Quality;
  ALogFont.lfPitchAndFamily := Default_Pitch;
  StrCopy (ALogFont.lfFaceName, PChar (Font.Name));
  hFont := CreateFontIndirect (ALogFont);
  Canvas.Font.Handle := hFont;
  Canvas.TextOut (300, 200, 'Rotating');
end;

end.

object Form1: TForm1
  Left = 229
  Top = 107
  Width = 503
  Height = 380
  Caption = 'SideText'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -27
  Font.Name = 'Arial'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnPaint = FormPaint
  PixelsPerInch = 96
  TextHeight = 32
  object Label1: TLabel
    Left = 40
    Top = 24
    Width = 289
    Height = 137
    Alignment = taCenter
    AutoSize = False
    Caption = 'Label1'
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 336
    Top = 88
  end
end