Форум: "Базы";
Текущий архив: 2003.11.13;
Скачать: [xml.tar.bz2];

Вниз

Отчеты   Найти похожие ветки 

← →
Chaked   (2003-10-17 17:23) [0]

Здорова народ. Подскажите кто знает plies как в отчете в названии колонок сделать надпись вертикальной.

---

← →
Johnmen   (2003-10-17 17:31) [1]

Помочь ссылкой или кодом ? :)

---

← →
Семен Сорокин   (2003-10-17 17:38) [2]

"кто знает plies"
я не знаю.
какой генератор отчетов то?

---

← →
Семен Сорокин   (2003-10-17 17:47) [3]

может пригодится, когда-то давно ваял, выводит мультистрочный текст под углом Angle с выравниванием VertAlignment.

unit QRMyLabel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
QuickRpt, Qrctrls;

type
tvAlignment = ( vaTop, vaCenter, vaBottom );

type
TQRMyLabel = class(TQRLabel)
private
FAngle : word; // угол наклона в градусах
FVertAlignment: tvAlignment; // выравнивание по вертикали
procedure SetAngle(Value:word);
procedure SetVertAlignment(Value: tvAlignment);
procedure PaintText(OfsX,OfsY:Integer;C:TCanvas);
protected
procedure Paint; override;
procedure Print(OfsX:Integer;OfsY:Integer); override;
public
constructor Create(AOwner:TComponent);override;
published
property VertAlignment: tvAlignment read FVertAlignment write SetVertAlignment;
property Angle:word read FAngle write SetAngle default 0;
end;

procedure Register;

implementation

{$R QRMyLabel.res}

procedure Register;
begin
RegisterComponents("QReport", [TQRMyLabel]);
end;

{Возвращает nPos-ную подстроку из строки cStr}
{nPos нумеруется с НУЛЯ (первый - 0!!!)}
function GetSubStr( const cStr: string; nPos: integer; var lNext: boolean ): string;
var
nj,
jj : integer;
cTmp : string;

begin
cTmp := cStr;
lNext := true;
for nj:= 0 to nPos - 1 do begin
{Пропускаем ненужные вначале}
jj:= Pos(" ", cTmp);
if jj = 0 then begin
cTmp := EmptyStr;
lNext := false;
Break
end;
Delete(cTmp, 1, jj)
end;
if Pos(" ", cTmp) > 0 then
Result:= copy(cTmp, 1, Pos(" ", cTmp) - 1)
else
Result:= cTmp;
end;

{ TQRMyLabel }

constructor TQRMyLabel.Create(AOwner: TComponent);
begin
inherited;
AutoSize := false;
FAngle := 0;
FVertAlignment := vaCenter;
end;

procedure TQRMyLabel.Paint;
begin
PaintText(0,0,Canvas);
end;

procedure TextOutAngle(C:TCanvas;x,y:Integer;A:Word;S:string;aRect: TRect);
var
LF:TLogFont;
NewFontHandle,OldFontHandle: HFONT;
begin
GetObject(C.Font.Handle,SizeOf(LF),Addr(LF));
LF.lfEscapement:=A*10;
LF.lfQuality:=DEFAULT_QUALITY;
NewFontHandle:=CreateFontIndirect(LF);
OldFontHandle:=SelectObject(C.Handle,NewFontHandle);
ExtTextOut(C.Handle, x, y, ETO_CLIPPED, @aRect, @S[1], length(S), nil);
// C.TextOut(x,y,S);
NewFontHandle:=SelectObject(C.Handle,OldFontHandle);
DeleteObject(NewFontHandle);
end;

procedure TQRMyLabel.Print(OfsX: Integer; OfsY: Integer);
begin
PaintText(Left+QRPrinter.XPos(OfsX),
Top+QRPrinter.YPos(OfsY),
QRPrinter.Canvas);
end;

procedure TQRMyLabel.SetAngle(Value: word);
begin
if FAngle<>Value then
begin
FAngle:=Value;
Invalidate;
end;
end;

procedure TQRMyLabel.SetVertAlignment(Value: tvAlignment);
begin
if FVertAlignment <> Value then begin
FVertAlignment := Value;
Invalidate
end
end;


---

← →
Семен Сорокин   (2003-10-17 17:47) [4]

продолжение

procedure TQRMyLabel.PaintText(OfsX,OfsY:Integer;C: TCanvas);
var
NewX, NewY : integer;
_w, _h : integer;
RAngle : real;
R : TRect;
_list : tStringList;
XShift : boolean;
_shift : integer;
_j : integer;
x, y : integer;

procedure GetStrings(var aList: tStringList);
var
_str : string;
_tmp : string;
_length : integer;
_i : integer;
_next : boolean;
begin
with aList do begin
_str := GetSubStr(Caption, 0, _next);
_tmp := EmptyStr;
_i := 0;
// Определимся в длине
if XShift then
_length := Round(Width/Cos(RAngle))
else
_length := Round(Height/Sin(RAngle));
while true do begin
while C.TextWidth(_str + _tmp) < _length do begin
_str := _str + " " + _tmp;
inc(_i);
_tmp := GetSubStr(Caption, _i, _next);
if not _Next then
Break
end;
Add( _str );
_str := _tmp;
_tmp := EmptyStr;
if not _Next then
Break
end
end
end;

begin
DisableAlign;
try
R:=Rect(OfsX,OfsY,OfsX+Width,OfsY+Height);

C.Brush.Color:=Color;

if Transparent then C.Brush.Style:=bsClear;

C.FillRect(R);
C.Font.Assign(Font);

RAngle:= (FAngle mod 360)/180*Pi;
_w := C.TextWidth(Caption);
_h := C.TextHeight(Caption);
NewX := OfsX;
NewY := OfsY + Round(Sin(RAngle)*_w);

if not AutoSize then begin

case VertAlignment of
vaTop:
NewY := OfsY + Round(_w*Sin(RAngle));
vaCenter:
NewY := OfsY + Height div 2 - Round(Sin(RAngle)*_w + Cos(RAngle)*_h) div 2 +
Round(Sin(RAngle)*_w)
else
NewY := OfsY + Height - Round(Cos(RAngle)*_h)
end;

case Alignment of
taLeftJustify:
NewX := OfsX;
taCenter:
NewX := OfsX + Width div 2 - Round(Cos(RAngle)*_w + Sin(RAngle)*_h) div 2
else
NewX := OfsX + Width - Round(Cos(RAngle)*_w + Sin(RAngle)*_h)
end
end;

if not AutoSize and WordWrap and
(NewX - Round(Sin(RAngle)*_w) < Top) and
(Caption <> EmptyStr) and (Pos(" ", Caption) > 0) then begin
_list := tStringList.Create;
try
XShift := FAngle mod 360 in [0..45, 135..225];
XShift := XShift or (FAngle mod 360 > 315);
GetStrings(_list);
_w := C.TextWidth(_list[0]);
_h := C.TextHeight(_list[0]);
for _j := 0 to _list.Count - 1 do begin
// Пересчет координат
if XShift then begin
_shift := Round(_h/Cos(RAngle));
if Alignment = taLeftJustify then begin
x := OfsX;
case VertAlignment of
vaTop:
y := OfsY + Round(_w*Sin(RAngle)) + _shift*_j; // OK
vaCenter:
y := OfsY + Height div 2 - (Round(Cos(RAngle)*_h) + _shift*(_list.Count - 1)) div 2 +
Round(_w*Sin(RAngle)) div 2 + _shift*_j // OK
else
y := OfsY + Height - Round(Cos(RAngle)*_h) - _shift*(_list.Count - 1) + _shift*_j // OK
end
end
else if AlignMent = taCenter then begin
x := OfsX + Width div 2 - Round(Cos(RAngle)*C.TextWidth(_list[_j]) +
Sin(RAngle)*_h) div 2;
case VertAlignment of
vaTop:
y := OfsY + Round(_w*Sin(RAngle)) div 2 +
Round(C.TextWidth(_list[_j])*Sin(RAngle)) div 2 + _shift*_j; // OK
vaCenter:
y := OfsY + Height div 2 - (Round(Cos(RAngle)*_h) + _shift*(_list.Count - 1)) div 2 +
Round(_w*Sin(RAngle)) div 2 + _shift*_j -
Round((_w - C.TextWidth(_list[_j]))*Sin(RAngle)) div 2 // OK
else
y := OfsY + Height - Round(Cos(RAngle)*_h) - _shift*(_list.Count - 1) + _shift*_j -
Round((_w - C.TextWidth(_list[_j]))*Sin(RAngle)) div 2 // OK
end
end
else begin
x := OfsX + Width - Round(Cos(RAngle)*C.TextWidth(_list[_j]) + Sin(RAngle)*_h);
case VertAlignment of
vaTop:
y := OfsY + Round(C.TextWidth(_list[_j])*Sin(RAngle)) + _shift*_j; // OK
vaCenter:
y := OfsY + Height div 2 - (Round(Cos(RAngle)*_h) + _shift*(_list.Count - 1)) div 2 +
Round(_w*Sin(RAngle)) div 2 + _shift*_j -
Round((_w - C.TextWidth(_list[_j]))*Sin(RAngle)) // OK
else
y := OfsY + Height - Round(Cos(RAngle)*_h) - _shift*(_list.Count - 1) + _shift*_j -
Round((_w - C.TextWidth(_list[_j]))*Sin(RAngle)) // OK
end
end;
end
else begin
_shift := Round(_h/Sin(RAngle));
case VertAlignment of
vaTop:
y := OfsY + Round(_w*Sin(RAngle));
vaCenter:
y := OfsY + Height div 2 - Round(Sin(RAngle)*_w + Cos(RAngle)*_h) div 2 +
Round(Sin(RAngle)*_w)
else
y := OfsY + Height - Round(Cos(RAngle)*_h)
end;
case Alignment of
taLeftJustify:
x := OfsX + _shift*_j;
taCenter:
x := OfsX + Width div 2 - (Round(Cos(RAngle)*_w +
Sin(RAngle)*_h) + _shift*(_list.Count - 1)) div 2 + _shift*_j
else
x := OfsX + Width - Round(Cos(RAngle)*_w +
Sin(RAngle)*_h) - _shift*_list.Count + _shift*_j
end
end;
TextOutAngle(C, x, y, FAngle, _list[_j], R)
end;
finally
_list.Free
end
end
else
TextOutAngle(C,NewX,NewY,FAngle,Caption, R);

if AutoSize then
SetBounds( Left,
Top,
Round(Cos(RAngle)*_w + Sin(RAngle)*_h),
Round(Sin(RAngle)*_w + Cos(RAngle)*_h) );

C.Brush.Style:=bsSolid;
C.Brush.Color:=Frame.Color;

{Отрисовка фрэйма}
if Frame.DrawLeft then
C.FillRect(Rect(R.Left,R.Top,R.Left+Frame.Width,R.Bottom));

if Frame.DrawBottom then
C.FillRect(Rect(R.Left,R.Bottom-Frame.Width,R.Right,R.Bottom));

if Frame.DrawRight then
C.FillRect(Rect(R.Right-Frame.Width,R.Top,R.Right,R.Bottom));

if Frame.DrawTop then
C.FillRect(Rect(R.Left,R.Top,R.Right,R.Top+Frame.Width));
finally
EnableAlign
end
end;

end.

---

← →
Chaked   (2003-10-17 18:26) [5]

У-у! А покороче нет способа.
Я вытягивыю на форму отчета компонент QRLabel, и вот мне нужно, что текст написанный там был вертикальным

---

← →
Chaked   (2003-10-17 18:27) [6]

А че, есть ссылки, так давай.

---

← →
Anatoly Podgoretsky   (2003-10-17 20:35) [7]

На сайт производителя, так есть

---

Страницы: 1 вся ветка

Форум: "Базы";
Текущий архив: 2003.11.13;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.036 c