Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Базы";
Текущий архив: 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.042 c
1-41219
1351
2003-11-01 17:03
2003.11.13
Как корректно удалить!

1-41312
qwe
2003-11-04 17:48
2003.11.13
Plugin s

3-40980
Kosta
2003-10-16 17:58
2003.11.13
Получение списка пользователей из MSSQL(2000)

7-42177
elected
2003-08-29 10:59
2003.11.13
Как сменить серийный номер тома ?

1-41422
Layner
2003-10-29 15:11
2003.11.13
Как получить в переменную значение выделеной ячейки StringGrid?




Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский