الكتابة في TLabel عموديا

[paix144]

بسم الله الرحمن الرحيم
السلام عليكم و رحمة الله
هنالك طريقتين للكتابة Label في عموديا
الطريقة الأولى:

1-نضع مكون على Label الفورم
2-نغيير خصائص Labelفي inspecteur d'objet كالتالي :
AutoSize:=False
3-في caption نضع فراغ بين الحرف و الآخر
D 4 A
ثم
WrodPrad:=True
قم بتغيير حجم Label لكي يقبل رسالة طويلة

الطريقة الثانية:
انقر بيمن الفأرة على الفورم

ثم انقر على x

ثم ابحث عن Label الذي تريد كتابته عموديا

و في Caption نظيف #10#13 بين الحرف و الآخر

Caption = 'L'#10#13'a'#10#13'b'#10#13'e'#10#13'l'#10#13'2'
لمن لم يفهم جيدا أنظر هذا الفديو

http://www.sendspace.com/file/hhvwor
بالتوفيق

[karamofweb]

يمكنك عمل بروسيدور كما في التطبيق الذي صنعته ... شكرا

[cargem]

Procedure vertical_text(input_string: string;memo:TMemo );
var
i: integer;
caract: char;
begin
if input_string = '' then
Exit;

for i := 1 to Length(input_string) + 1 do
Begin
caract := input_string[i];
memo.Lines.Add(caract) ;//:= memo.Text + + #$A#$d;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
vertical_text(Edit1.Text, Memo1);
end;

[B.M.AbdelAziZ]

السلام عليكم و رحمة الله

وهذه طريقة اخرى...
http://www.swissdelphicenter.ch/screenshots/tip506.png

type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
procedure VerticalTitleBar(Texto: string; Size: Integer);
end;

const
MY_TITLE_TEXT = 'Vertical Text';
var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.VerticalTitleBar(TexTo: string; Size: Integer);
var
LogFont: TLogFont;
tmpCanvas: TCanvas;
tmpRect: TRect;
x1, x2, y1, y2: integer;
begin
tmpCanvas := TCanvas.Create;
tmpCanvas.Handle := GetWindowDc(Handle);
try
GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
with LogFont do
begin
lfEscapement := 90 * 10;
lfOrientation := 90 * 10;
lfOutPrecision := OUT_TT_ONLY_PRECIS;
lfFaceName := 'Arial';
lfHeight := Size;
lfWeight := FW_BOLD;
lfQuality := PROOF_QUALITY;
end;
with tmpCanvas do
begin
Font.Handle := CreateFontIndirect(LogFont);
Font.Color := clWhite;
Brush.Color := clNavy;
end;
x1 := GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXBORDER);
x2 := 20;
y1 := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE) +
GetSystemMetrics(SM_CYBORDER) + 1;
y2 := Height - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER);
tmpRect := Rect(x1, y1, x2, y2);
tmpCanvas.FillRect(tmpRect);
DrawText(tmpCanvas.Handle, PChar(Texto), - 1, tmpRect, DT_BOTTOM or
DT_SINGLELINE);
finally
tmpCanvas.Free;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
VerticalTitleBar(MY_TITLE_TEXT, 12);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
VerticalTitleBar(MY_TITLE_TEXT, 12);
end;

end.

المصدر

http://www.swissdelphicenter.ch/torry/showcode.php?id=506

[cargem]

وهذا مثال
vertical text

uses
{...} Grids;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
end;

{...}

implementation

{...}

// Display text vertically in StringGrid cells
// Vertikale Textausgabe in den Zellen eines StringGrid
procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect: TRect;
Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);
var
lf: TLogFont;
tf: TFont;
begin
// if the font is to big, resize it
// wenn Schrift zu groß dann anpassen
if (Size Grid.ColWidths[ACol] div 2) then
Size := Grid.ColWidths[ACol] div 2;
with Grid.Canvas do
begin
// Replace the font
// Font setzen
Font.Name := Schriftart;
Font.Size := Size;
Font.Color := Color;
tf := TFont.Create;
try
tf.Assign(Font);
GetObject(tf.Handle, SizeOf(lf), @lf);
lf.lfEscapement := 900;
lf.lfOrientation := 0;
tf.Handle := CreateFontIndirect(lf);
Font.Assign(tf);
finally
tf.Free;
end;
// fill the rectangle
// Rechteck füllen
FillRect(Rect);
// Align text and write it
// Text nach Ausrichtung ausgeben
if Alignment = taLeftJustify then
TextRect(Rect, Rect.Left + 2,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);
if Alignment = taCenter then
TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size +
Size div 3,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);
if Alignment = taRightJustify then
TextRect(Rect, Rect.Right - Size - Size div 2 - 2,Rect.Bottom -
2,Grid.Cells[ACol, ARow]);
end;
end;

// 2. Alternative: Display text vertically in StringGrid cells
// 2. Variante: Vertikale Textausgabe in den Zellen eines StringGrid
procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACo l:Integer;Rect:TRect;
Schriftart:String;Size:Integer;Color:TColor;Alignm ent:TAlignment);
var
NewFont, OldFont : Integer;
FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;
begin
// if the font is to big, resize it
// wenn Schrift zu groß dann anpassen
If (Size Grid.ColWidths[ACol] DIV 2) Then
Size := Grid.ColWidths[ACol] DIV 2;
with Grid.Canvas do
begin
// Set font
// Font setzen
If (fsBold IN Font.Style) Then
FontStyle := FW_BOLD
Else
FontStyle := FW_NORMAL;

If (fsItalic IN Font.Style) Then
FontItalic := 1
Else
FontItalic := 0;

If (fsUnderline IN Font.Style) Then
FontUnderline := 1
Else
FontUnderline := 0;

If (fsStrikeOut IN Font.Style) Then
FontStrikeout:=1
Else
FontStrikeout:=0;

Font.Color := Color;

NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic,
FontUnderline, FontStrikeout, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH, PChar(Schriftart));

OldFont := SelectObject(Handle, NewFont);
// fill the rectangle
// Rechteck füllen
FillRect(Rect);
// Write text depending on the alignment
// Text nach Ausrichtung ausgeben
If Alignment = taLeftJustify Then
TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);
If Alignment = taCenter Then
TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3,
Rect.Bottom-2,Grid.Cells[ACol,ARow]);
If Alignment = taRightJustify Then
TextRect(Rect,Rect.Right-Size - Size DIV 2 - 2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

// Recreate reference to the old font
// Referenz auf alten Font wiederherstellen
SelectObject(Handle, OldFont);
// Recreate reference to the new font
// Referenz auf neuen Font löschen
DeleteObject(NewFont);
end;
end;

// Call the method in OnDrawCell
// Methode im OnDrawCell aufrufen
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
// In the second column: Rotate Text by 90° and left align the text
// Text um 90°gedreht ausgeben, linksbündig in der zweiten Spalte
if ACol = 1 then
StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL',
12,clRed, taLeftJustify);

// In the third column: Center the text
// Ausgabe zentriert in der dritten Spalte
if ACol = 2 then
StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter);

// In all other columns third row: right align the text
// Ausgabe rechtsbündig in den restlichen Spalten
if ACol 2 then
StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen,
taRightJustify);
end;

end.

procedure VerticalTypewriter(text: string; image: TImage; delay: integer);
var
x, y, i: integer;
begin
image.Canvas.Refresh;
application.ProcessMessages;
y := 1;

for i := 1 to length(text) do
begin
application.ProcessMessages;
y := y + image.Canvas.TextHeight(text[i]);
x := image.width div 2 - (image.Canvas.TextWidth(text[i]) div 2);
image.Canvas.TextOut(x, y, text[i]);
sleep(delay);
end;

end;

// Horizontal Typewriter ( , , , )
procedure HorizontalTypewriter(text: string; image: TImage;
delay, space: integer);
var
x, y, i: integer;
begin
image.Canvas.Refresh;
application.ProcessMessages;
x := 1;

for i := 1 to length(text) do
begin
application.ProcessMessages;
y := image.Picture.Height div 2 - (image.Canvas.TextHeight(text[i]) div 2);
x := x + image.Canvas.TextWidth(text[i]) + space;
image.Canvas.TextOut(x, y, text[i]);
sleep(delay);
end;

end;

// Sample calls:
procedure TForm1.Button1Click(Sender: TObject);
begin
//
VerticalTypewriter('HELLO BIG-X', Image1, 100);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//
HorizontalTypewriter('Hello Big-X', Image2, 100, 1);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
HorizontalTypewriter(Edit1.text, Image2, 100, 1);
VerticalTypewriter(Edit1.text, Image1, 100);
end;

[cargem]

مثال اخر

How to Draw a Gradient Fill on a (Delphi's VCL) Canvas

Here are two custom Delphi functions to paint a Canvas object using gradient fill from one color value to another, either vertical or horizontal:

uses Math, ...

procedure GradHorizontal(Canvas:TCanvas; Rect:TRect; FromColor, ToColor:TColor) ;
var
X:integer;
dr,dg,db:Extended;
C1,C2:TColor;
r1,r2,g1,g2,b1,b2:Byte;
R,G,B:Byte;
cnt:integer;
begin
C1 := FromColor;
R1 := GetRValue(C1) ;
G1 := GetGValue(C1) ;
B1 := GetBValue(C1) ;

C2 := ToColor;
R2 := GetRValue(C2) ;
G2 := GetGValue(C2) ;
B2 := GetBValue(C2) ;

dr := (R2-R1) / Rect.Right-Rect.Left;
dg := (G2-G1) / Rect.Right-Rect.Left;
db := (B2-B1) / Rect.Right-Rect.Left;

cnt := 0;
for X := Rect.Left to Rect.Right-1 do
begin
R := R1+Ceil(dr*cnt) ;
G := G1+Ceil(dg*cnt) ;
B := B1+Ceil(db*cnt) ;

Canvas.Pen.Color := RGB(R,G,B) ;
Canvas.MoveTo(X,Rect.Top) ;
Canvas.LineTo(X,Rect.Bottom) ;
inc(cnt) ;
end;
end;

procedure GradVertical(Canvas:TCanvas; Rect:TRect; FromColor, ToColor:TColor) ;
var
Y:integer;
dr,dg,db:Extended;
C1,C2:TColor;
r1,r2,g1,g2,b1,b2:Byte;
R,G,B:Byte;
cnt:Integer;
begin
C1 := FromColor;
R1 := GetRValue(C1) ;
G1 := GetGValue(C1) ;
B1 := GetBValue(C1) ;

C2 := ToColor;
R2 := GetRValue(C2) ;
G2 := GetGValue(C2) ;
B2 := GetBValue(C2) ;

dr := (R2-R1) / Rect.Bottom-Rect.Top;
dg := (G2-G1) / Rect.Bottom-Rect.Top;
db := (B2-B1) / Rect.Bottom-Rect.Top;

cnt := 0;
for Y := Rect.Top to Rect.Bottom-1 do
begin
R := R1+Ceil(dr*cnt) ;
G := G1+Ceil(dg*cnt) ;
B := B1+Ceil(db*cnt) ;

Canvas.Pen.Color := RGB(R,G,B) ;
Canvas.MoveTo(Rect.Left,Y) ;
Canvas.LineTo(Rect.Right,Y) ;
Inc(cnt) ;
end;
end;


وهذا ايظا

How to Draw a Gradient Fill on a (Delphi's VCL) Canvas

Here are two custom Delphi functions to paint a Canvas object using gradient fill from one color value to another, either vertical or horizontal:

uses Math, ...

procedure GradHorizontal(Canvas:TCanvas; Rect:TRect; FromColor, ToColor:TColor) ;
var
X:integer;
dr,dg,db:Extended;
C1,C2:TColor;
r1,r2,g1,g2,b1,b2:Byte;
R,G,B:Byte;
cnt:integer;
begin
C1 := FromColor;
R1 := GetRValue(C1) ;
G1 := GetGValue(C1) ;
B1 := GetBValue(C1) ;

C2 := ToColor;
R2 := GetRValue(C2) ;
G2 := GetGValue(C2) ;
B2 := GetBValue(C2) ;

dr := (R2-R1) / Rect.Right-Rect.Left;
dg := (G2-G1) / Rect.Right-Rect.Left;
db := (B2-B1) / Rect.Right-Rect.Left;

cnt := 0;
for X := Rect.Left to Rect.Right-1 do
begin
R := R1+Ceil(dr*cnt) ;
G := G1+Ceil(dg*cnt) ;
B := B1+Ceil(db*cnt) ;

Canvas.Pen.Color := RGB(R,G,B) ;
Canvas.MoveTo(X,Rect.Top) ;
Canvas.LineTo(X,Rect.Bottom) ;
inc(cnt) ;
end;
end;

procedure GradVertical(Canvas:TCanvas; Rect:TRect; FromColor, ToColor:TColor) ;
var
Y:integer;
dr,dg,db:Extended;
C1,C2:TColor;
r1,r2,g1,g2,b1,b2:Byte;
R,G,B:Byte;
cnt:Integer;
begin
C1 := FromColor;
R1 := GetRValue(C1) ;
G1 := GetGValue(C1) ;
B1 := GetBValue(C1) ;

C2 := ToColor;
R2 := GetRValue(C2) ;
G2 := GetGValue(C2) ;
B2 := GetBValue(C2) ;

dr := (R2-R1) / Rect.Bottom-Rect.Top;
dg := (G2-G1) / Rect.Bottom-Rect.Top;
db := (B2-B1) / Rect.Bottom-Rect.Top;

cnt := 0;
for Y := Rect.Top to Rect.Bottom-1 do
begin
R := R1+Ceil(dr*cnt) ;
G := G1+Ceil(dg*cnt) ;
B := B1+Ceil(db*cnt) ;

Canvas.Pen.Color := RGB(R,G,B) ;
Canvas.MoveTo(Rect.Left,Y) ;
Canvas.LineTo(Rect.Right,Y) ;
Inc(cnt) ;
end;
end;