tsglib.pas

企业进销存管理系统

            ARect.Left := Left;
        end;

        Text := Text + TextLen - PrintChars;
        SelStart := SelStart - (TextLen - PrintChars);
        Left := ARect.Right - PrintWidth;
    end
    else if Align = taCenter then
    begin
        GetVisibleChars(Canvas.Handle, Metric, Text, TextLen, ARect.Right - Left,
                        PrintChars, PrintWidth, Align);
        LeftOffset := (ARect.Right - ARect.Left - PrintWidth) div 2;
        CanCenter := (LeftOffset >= Left - ARect.Left);

        if TextOffset > 0 then
        begin
            Text := Text + TextOffset;
            TextLen := TextLen - TextOffset;
            SelStart := SelStart - TextOffset;
            GetVisibleChars(Canvas.Handle, Metric, Text, TextLen, ARect.Right - Left,
                            PrintChars, PrintWidth, Align);
        end;

        if CanCenter then
        begin
            LeftOffset := (ARect.Right - ARect.Left - PrintWidth) div 2;
            Left := ARect.Left + LeftOffset;
        end;
    end;

    repeat
        PReturn := StrNScanEol(Text, PrintChars);
        if PReturn = nil then
        begin
            DisplayTextWithSelect(Canvas, Metric, Text, PrintChars, ClipRect, Left, Top,
                                  SelStart, SelLength, SelColor, SelFontColor, AccelPos, 0);
            PrintChars := 0;
        end
        else
        begin
            DisplayTextWithSelect(Canvas, Metric, Text, PReturn - Text, ClipRect, Left, Top,
                                  SelStart, SelLength, SelColor, SelFontColor, AccelPos, 0);

            GetTextExtent(Canvas.Handle, Metric, Text, PReturn - Text, TextSize);
            Left := Left + TextSize.CX;
            ARect.Left := ARect.Left + TextSize.CX;

            SelStart := SelStart - (PReturn - Text);
            AccelPos := AccelPos - (PReturn - Text);
            DisplayTextWithSelect(Canvas, Metric, RETURN_DISPLAY_CHAR, Length(RETURN_DISPLAY_CHAR), ClipRect, Left, Top,
                                  SelStart, SelLength, SelColor, SelFontColor, AccelPos, 0);

            GetTextExtent(Canvas.Handle, Metric, RETURN_DISPLAY_CHAR, Length(RETURN_DISPLAY_CHAR), TextSize);
            Left := Left + TextSize.CX;
            ARect.Left := ARect.Left + TextSize.CX;

            Chars := NextCharCount(PReturn, 0);
            SelStart := SelStart - Chars;
            AccelPos := AccelPos - Chars;
            PrintChars := PrintChars - (PReturn - Text) - Chars;
            Text := PReturn + Chars;
        end;
    until (PrintChars <= 0) or (ARect.Left > ARect.Right);

    if ARect.Bottom < TextRect.Bottom then
    begin
        ARect.Left := TextRect.Left;
        ARect.Top := ARect.Top + Metric.tmHeight + LineSpacing;
        ARect.Bottom := TextRect.Bottom;
        DisplayTextWithSelect(Canvas, Metric, '', 0, ClipRect, Left, Top, 0, 0,
                              SelColor, SelFontColor, AccelPos, 0);
    end;
end;

function TextLineSpacing(const Metric: TTextMetric): Integer;
begin
    Result := 0;
    if not tsIsFarEast then Exit;
    if Metric.tmExternalLeading > 0 then Result := 1;
end;

function GetVertTopOffset(Top: Integer; TextRect: TRect; TextLines: TtsIntegerList;
                          LineSpacing: Integer; VertAlign: TtsVertAlignment; const Metric: TTextMetric): Integer;
var
    CurLine: Integer;
begin
    Result := Top;
    if TextLines <> nil then
    begin
        if VertAlign = vtaBottom then
        begin
            CurLine := 1;
            Result := TextRect.Bottom - Metric.tmHeight;
            while (Result - (Metric.tmHeight + LineSpacing) >= Top) and
                  (CurLine < TextLines.Count) do
            begin
                Inc(CurLine);
                Result := Result - (Metric.tmHeight + LineSpacing);
            end;
        end
        else if VertAlign = vtaCenter then
        begin
            if TextRect.Bottom - Top > TextLines.Count * (Metric.tmHeight + LineSpacing) + 1 then
                Result := Top + (((TextRect.Bottom - Top) - (TextLines.Count * (Metric.tmHeight + LineSpacing))) div 2);
        end;
    end;
end;

procedure DisplayText(Canvas : TCanvas; Text : PChar; RowHeight : Integer;
                      TextRect : TRect; Left, Top : Integer;
                      Align : TAlignment; VertAlign: TtsVertAlignment;
                      CanWordWrap: Boolean; AccelPos: Integer);
var
    Dc : Hdc;
    Chars : Integer;
    PrintChars : Integer;
    DrawWidth : Integer;
    Options : Integer;
    Metric : TTextMetric;
    TextSize : TSize;
    LeftOffset : Integer;
    LeftMarginPos : Integer;
    TextLen : Integer;
    TopOffset, LineSpacing: Integer;
    TextLines: TtsIntegerList;
    CurLine, MaxLines: Integer;
    OldBkMode: Integer;
begin
    if TextRect.Left >= TextRect.Right then Exit;

    Dc := Canvas.Handle;
    Options := ETO_CLIPPED;
    GetTextMetrics(Canvas.Handle, Metric);
    LineSpacing := TextLineSpacing(Metric);
    TopOffset := LineSpacing;
    Top := Top + TopOffset;

    if Text = nil then Text := '';

    OldBkMode := SetBkMode(Dc, TRANSPARENT);
    try
        if (not CanWordWrap) or (not IsMultiLineText(RowHeight - TopOffset, Metric.tmHeight + LineSpacing)) then
        begin
            TextLen := StrLen(Text);
            if (Align = taLeftJustify) and (VertAlign in [vtaDefault, vtaTop]) and
               (StrNScanEol(Text, TextLen) = nil) then
            begin
                Canvas.FillRect(TextRect);
                TextOutAccel(Canvas, Metric, Left, Top, Options, @TextRect, Text,
                             TextLen, nil, AccelPos);
            end
            else
                DisplayTextLineSingle(Canvas, Metric, Text, TextLen, 0, TextRect,
                                      Left, Top, 0, 0, 0, 0, Align, VertAlign, AccelPos);
        end
        else
        begin
            DrawWidth := TextRect.Right - Left;
            Canvas.FillRect(TextRect);

            if Align = taRightJustify then
            begin
                if (TextRect.Left <> Left) then
                begin
                    Canvas.FillRect(Rect(TextRect.Left, TextRect.Top, Left, TextRect.Bottom));
                    TextRect.Left := Left;
                end;

                DrawWidth := DrawWidth - RIGHT_PRINT_MARGIN;
            end;

            LeftMarginPos := Left;

            TextLines := nil;
            try
                if not (VertAlign in [vtaDefault, vtaTop]) then
                begin
                    if Text[0] <> #0 then
                    begin
                        TextLines := TtsIntegerList.Create;
                        MaxLines := ((TextRect.Bottom - TextRect.Top) div (Metric.tmHeight + LineSpacing)) + 1;
                        GetTextLines(Canvas.Handle, Text, RowHeight, DrawWidth, Align,
                                     CanWordWrap, TextLines, MaxLines);
                    end;
                end;

                CurLine := 0;
                Top := GetVertTopOffset(Top, TextRect, TextLines, LineSpacing, VertAlign, Metric);
                while (TextRect.Top <= TextRect.Bottom) do
                begin
                    if TextLines = nil then
                    begin
                        if not GetNextLine(Canvas.Handle, Metric, Text, DrawWidth - 1, Align, Chars) then
                            Break;
                    end
                    else
                    begin
                        if CurLine > TextLines.Count - 1 then Break;
                        if CurLine < TextLines.Count - 1
                            then Chars := TextLines.Item[CurLine+1] - TextLines.Item[CurLine]
                            else Chars := StrLen(Text);
                        Inc(CurLine);
                    end;

                    PrintChars := Chars;
                    if LastCharIsEofLine(Text, Chars) then
                        PrintChars := PrintChars - PrevCharCount(Text, Chars);

                    if Align = taRightJustify then
                    begin
                        GetTextExtent(Dc, Metric, Text, PrintChars, TextSize);
                        Left := TextRect.Right - (TextSize.CX + RIGHT_PRINT_MARGIN);
                        if TextSize.CX > 0 then Left := Left - Metric.tmOverhang
                    end
                    else if Align = taCenter then
                    begin
                        GetTextExtent(Dc, Metric, Text, PrintChars, TextSize);
                        if TextSize.CX > 0 then TextSize.CX := TextSize.CX + Metric.tmOverhang;

                        LeftOffset := (TextRect.Right - TextRect.Left - TextSize.CX) div 2;
                        if LeftOffset > Left - TextRect.Left then
                            Left := TextRect.Left + LeftOffset
                    end;

                    TextOutAccel(Canvas, Metric, Left, Top, Options, @TextRect, Text, PrintChars,
                                 nil, AccelPos);

                    Top := Top + Metric.tmHeight + LineSpacing;
                    TextRect.Top := Top;

                    Text := Text + Chars;
                    AccelPos := AccelPos - Chars;
                    Left := LeftMarginPos;
                end;
            finally
                TextLines.Free;
            end;
        end;
    finally
        SetBkMode(Dc, OldBkMode);
    end;
end;

procedure DisplayTextLinesMulti(Canvas : TCanvas; Metric : TTextMetric; Text : PChar;
                                TextRect : TRect; Left, Top : Integer; FirstRow : Integer;
                                Lines : TtsIntegerList; SelStart, SelLength : Integer;
                                SelColor, SelFontColor : TColor; Align : TAlignment; VertAlign: TtsVertAlignment);
var
    I : Integer;
    Dc : Hdc;
    Chars : Integer;
    PrintChars : Integer;
    ARect : TRect;
    TextSize : TSize;
    LeftOffset : Integer;
    LeftMarginPos : Integer;
    LineSpacing: Integer;
begin
    Dc := Canvas.Handle;
    Text := Text + Lines.Item[FirstRow];
    SelStart := SelStart - Lines.Item[FirstRow];
    LineSpacing := TextLineSpacing(Metric);

    if (Align = taRightJustify) and (TextRect.Left <> Left) then
    begin
        Canvas.FillRect(Rect(TextRect.Left, TextRect.Top, Left, TextRect.Bottom));
        TextRect.Left := Left;
    end;

    Top := GetVertTopOffset(Top, TextRect, Lines, LineSpacing, VertAlign, Metric);
    ARect := TextRect;
    ARect.Top := Top;
    ARect.Bottom := ARect.Top + Metric.tmHeight + LineSpacing;
    if ARect.Bottom > TextRect.Bottom then ARect.Bottom := TextRect.Bottom;

    LeftMarginPos := Left;
    Canvas.FillRect(TextRect);

    for I := FirstRow to Lines.Count - 1 do
    begin
        Left := LeftMarginPos;
        if (ARect.Top > TextRect.Bottom) then Break;

        if I = Lines.Count - 1 then
            Chars := StrLen(Text)
        else
            Chars := Lines.Item[I + 1] - Lines.Item[I];

        PrintChars := Chars;
        if LastCharIsEofLine(Text, Chars) then
            PrintChars := PrintChars - PrevCharCount(Text, Chars);

        if Align = taRightJustify then
        begin
            GetTextExtent(Dc, Metric, Text, PrintChars, TextSize);
            if TextSize.CX > 0 then Inc(TextSize.CX, Metric.tmOverhang);
            Left := ARect.Right - (TextSize.CX + RIGHT_PRINT_MARGIN);
        end
        else if Align = taCenter then
        begin
            GetTextExtent(Dc, Metric, Text, PrintChars, TextSize);
            if TextSize.CX > 0 then Inc(TextSize.CX, Metric.tmOverhang);
            LeftOffset := (TextRect.Right - TextRect.Left - TextSize.CX) div 2;

            if LeftOffset > Left - TextRect.Left then
                Left := TextRect.Left + LeftOffset
        end;

        DisplayTextWithSelect(Canvas, Metric, Text, PrintChars, ARect, Left, Top,
                              SelStart, SelLength, SelColor, SelFontColor, 0, LineSpacing);

        Text := Text + Chars;
        SelStart := SelStart - Chars;

        Top := Top + Metric.tmHeight + LineSpacing;
        ARect.Top := Top;
        ARect.Bottom := ARect.Top + Metric.tmHeight + LineSpacing;
        if ARect.Bottom > TextRect.Bottom then ARect.Bottom := TextRect.Bottom;

        Left := LeftMarginPos;
    end;

    if Lines.Count - 1 < FirstRow then
        DisplayTextWithSelect(Canvas, Metric, '', 0, ARect, Left, Top, 0, 0,
                              SelColor, SelFontColor, 0, LineSpacing)
    else if ARect.Top < TextRect.Bottom then
    begin
        ARect.Bottom := TextRect.Bottom;
        DisplayTextWithSelect(Canvas, Metric, '', 0, ARect, Left, Top, 0, 0,
                              SelColor, SelFontColor, 0, LineSpacing)
    end;
end;

procedure DisplayTextLines(Canvas : TCanvas; Text : PChar; RowHeight : Integer;
                           TextRect : TRect; Left, Top : Integer;
                           FirstChar, FirstRow : Integer;
                           Lines : TtsIntegerList; SelStart, SelLength : Integer;
                           SelColor, SelFontColor : TColor; Align : TAlignment;
                           VertAlign: TtsVertAlignment; CanWordWrap: Boolean);
var
    Metric : TTextMetric;
    TextLen : Integer;
    TextOffset: Integer;
    TopOffset, LineSpacing: Integer;
begin
    if TextRect.Left >= TextRect.Right then Exit;
    GetTextMetrics(Canvas.Handle, Metric);
    LineSpacing := TextLineSpacing(Metric);
    TopOffset := LineSpacing;
    Top := Top + TopOffset;

    if Lines = nil then
    begin
        Canvas.FillRect(TextRect);
        DisplayTextWithSelect(Canvas, Metric, '', 0, TextRect, Left, Top, 0, 0,
                              SelColor, SelFontColor, 0, 0);
        Exit;
    end;

    if Text = nil then Text := '';
    if (not CanWordWrap) or (not IsMultiLineText(RowHeight - TopOffset, Metric.tmHeight + LineSpacing)) then
    begin
        if Align in [taLeftJustify, taCenter] then
        begin
            TextLen := StrLen(Text);
            TextOffset := FirstChar;
        end
        else
        begin
            TextLen := FirstChar;
            TextOffset := 0;
        end;

        DisplayTextLineSingle(Canvas, Metric, Text, TextLen, TextOffset,
                              TextRect, Left, Top, SelStart, SelLength,
                              SelColor, SelFontColor, Align, VertAlign, 0)
    end
    else
    begin
        DisplayTextLinesMulti(Canvas, Metric, Text, TextRect, Left, Top,
                              FirstRow, Lines, SelStart, SelLength,
                              SelColor, SelFontColor, Align, VertAlign);
    end;
end;

procedure CheckOverhangIncluded;
var
    Bmp: TBitmap;
    WidthSingle, WidthDouble: Integer;
    Size: TSize;
    CharCnt: Integer;
begin
    OverhangIncluded := False;
    Bmp := TBitmap.Create;
    try
        Bmp.Canvas.Font.Name := 'MS Sans Serif';
        Bmp.Canvas.Font.Style := [fsItalic];
        CharCnt := NextCharCount('XX', 0);
        GetTextExtentPoint32(Bmp.Canvas.Handle, 'XX', CharCnt, Size);
        WidthSingle := Size.CX;
        GetTextExtentPoint32(Bmp.Canvas.Handle, 'XX', 2 * CharCnt, Size);
        WidthDouble := Size.CX;
        OverhangIncluded := (2 * WidthSingle > WidthDouble);
    finally
        Bmp.Free;
    end;
end;

initialization
begin
    CheckOverhangIncluded;
end;

end.