tsglib.pas

企业进销存管理系统

{*******************************************************}
{                                                       }
{       Top Support Delphi Library                      }
{       TopGrid cell text drawing routines              }
{                                                       }
{       Copyright (c) 1997 - 1999, Top Support          }
{                                                       }
{*******************************************************}

unit TSGLib;

interface

uses
    Windows, SysUtils, Graphics, Classes, TSSetLib, TSCommon;

const
    RIGHT_PRINT_MARGIN = 1;

function  IsSpaceChar(PText: PChar; Index: Integer) : Boolean;
function  IsTextChar(PText: PChar; Index: Integer) : Boolean;
function  NextWordCount(PText : PChar; Offset : Integer) : Integer;
function  PrevWordCount(PText : PChar; Offset : Integer) : Integer;
function  IsLeadByte(Key: Char): Boolean;
function  StrRNSpaceScan(Text : PChar; Chars : Cardinal) : PChar;
function  StrNSkipSpace(Text: PChar; Chars: Cardinal): PChar;
function  StrRNTextScan(Text : PChar; Chars : Cardinal) : PChar;
function  StrNScanEol(Text: PChar; Chars: Integer): PChar;
function  LastCharIsEofLine(PText : PChar; Offset : Integer) : Boolean;
procedure GetPrintCharWidth(Canvas : TCanvas; Metric: TTextMetric; Text : PChar;
                            Chars : Integer; MultiLine : Boolean; WithOverhang: Boolean; var Width : Integer);
function  IsMultiLineText(RowHeight : Integer; TextHeight : Integer) : Boolean;
procedure PCountChars(Text: PChar; MaxChars, TextLen: Integer; var CharCount, ByteCount: Integer; Reverse: Boolean);
function  PCharToByteLen(Text: PChar; MaxChars, TextLen: Integer; Reverse: Boolean): Integer;
function  PByteToCharLen(Text: PChar; MaxLen, TextLen: Integer): Integer;
function  GetNextLine(Dc : Hdc; Metric : TTextMetric; Text : PChar; DrawWidth : Integer;
                      Align : TAlignment; var Chars : Integer) : Boolean;
procedure GetTextLines(Dc : Hdc; Text : PChar; RowHeight : Integer; DrawWidth : Integer;
                       Align : TAlignment; CanWordWrap: Boolean; var Lines : TtsIntegerList; MaxLines: Integer);
procedure GetTextHeight(Dc : Hdc; Text : PChar; DrawWidth : Integer; Align : TAlignment;
                        CanWordWrap: Boolean; var TextLines, TextHeight: Integer);
function  TextLineSpacing(const Metric: TTextMetric): Integer;
function  GetVertTopOffset(Top: Integer; TextRect: TRect; TextLines: TtsIntegerList;
                           LineSpacing: Integer; VertAlign: TtsVertAlignment; const Metric: TTextMetric): Integer;
procedure DisplayText(Canvas : TCanvas; Text : PChar; RowHeight : Integer; TextRect : TRect;
                      Left, Top : Integer; Align : TAlignment; VertAlign: TtsVertAlignment;
                      CanWordWrap: Boolean; AccelPos: Integer);
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);

implementation

uses
    TSMbcs;

const
    RETURN_DISPLAY_CHAR = ' ';
    RETURN_DISPLAY_LEN = 1;

type
    TPolyRect = array[1..10] of TPoint;

var
    OverhangIncluded: Boolean;

function GetTextExtent(Dc: Hdc; Metric: TTextMetric; Text: PChar;
                       Chars: Integer; var TextSize: TSize): Boolean;
begin
    Result := GetTextExtentPoint32(Dc, Text, Chars, TextSize);
    if (OverhangIncluded) and (TextSize.CX > 0) then Dec(TextSize.CX, Metric.tmOverhang);
end;

procedure TextOutAccel(Canvas: TCanvas; const Metric: TTextMetric; X, Y: Integer;
                       Options: Longint; Rect: PRect; Str: PChar; Count: Longint;
                       Dx: PInteger; AccelPos: Integer);
var
    OldStyle: TFontStyles;
    StartTextSize, AccelKeySize: TSize;
    AccelChars: Integer;
begin
    if (AccelPos <= 0) or (AccelPos > Count) then
        ExtTextOut(Canvas.Handle, X, Y, Options, Rect, Str, Count, Dx)
    else
    begin
        AccelChars := NextCharCount(Str + AccelPos - 1, 0);
        GetTextExtent(Canvas.Handle, Metric, Str, AccelPos - 1, StartTextSize);
        GetTextExtent(Canvas.Handle, Metric, Str + AccelPos - 1, AccelChars, AccelKeySize);

        if AccelPos - 1 > 0 then
        begin
            ExtTextOut(Canvas.Handle, X, Y, Options, Rect, Str, AccelPos - 1, Dx);
            X := X + StartTextSize.CX;
            Rect.Left := X;
        end;

        if Rect.Right > Rect.Left then
        begin
            OldStyle := Canvas.Font.Style;
            Canvas.Font.Style := OldStyle + [fsUnderline];
            ExtTextOut(Canvas.Handle, X, Y, Options, Rect, Str + AccelPos - 1, AccelChars, Dx);
            Canvas.Font.Style := OldStyle;
        end;

        if AccelPos + AccelChars <= Count then
        begin
            X := X + AccelKeySize.CX;
            Rect.Left := X;
            if Rect.Right > Rect.Left then
            begin
                ExtTextOut(Canvas.Handle, X, Y, Options, Rect, Str + AccelPos - 1 + AccelChars,
                           Count - (AccelPos - 1) - AccelChars, Dx);
            end;
        end;
    end;
end;

function  IsLeadByte(Key: Char): Boolean;
begin
    Result := Key in LeadBytes;
end;

function StrNScanEol(Text: PChar; Chars: Integer): PChar;
var
    Ptr1, Ptr2: PChar;
begin
    Ptr1 := AnsiStrNScan(Text, Chr(VK_RETURN), Chars);
    Ptr2 := AnsiStrNScan(Text, Chr(CH_LINEFEED), Chars);

    if Ptr1 = nil then
        Result := Ptr2
    else if Ptr2 = nil then
        Result := Ptr1
    else if Ptr1 < Ptr2 then
        Result := Ptr1
    else
        Result := Ptr2;
end;

function IsSpaceChar(PText: PChar; Index: Integer) : Boolean;
begin
    Result := False;
    if StrByteType(PText, Index) <> mbSingleByte then Exit;
    Result := (Ord(PText[Index]) = VK_TAB) Or (PText[Index] = ' ');
end;

function IsTextChar(PText: PChar; Index: Integer) : Boolean;
begin
    Result := (not IsSpaceChar(PText, Index)) and
              (not EofLineChar(PText, Index)) and
              (PText[Index] <> #0)
end;

function StrRNSpaceScan(Text : PChar; Chars : Cardinal) : PChar;
var
    Ptr : PChar;
begin
    Result := AnsiStrRNScan(Text, ' ', Chars);
    Ptr := AnsiStrRNScan(Text, Chr(VK_TAB), Chars);
    if Ptr > Result then Result := Ptr;
end;

function StrRNTextScan(Text : PChar; Chars : Cardinal) : PChar;
var
    CharCnt: Cardinal;
begin
    CharCnt := 0;
    Result := nil;
    while Chars >= 1 do
    begin
        CharCnt := PrevCharCount(Text, Chars);
        if IsTextChar(Text + Chars - CharCnt, 0) then Break;
        Chars := Chars - CharCnt;
    end;

    if Chars >= 1 then Result := Text + Chars - CharCnt;
end;

function StrNSkipSpace(Text: PChar; Chars: Cardinal): PChar;
var
    Count, CharCnt: Cardinal;
begin
    Count := 0;
    while Count < Chars do
    begin
        if not IsSpaceChar(Text, Count) then Break;
        CharCnt := NextCharCount(Text, Count);
        Count := Count + CharCnt
    end;
    Result := Text + Count;
end;

function NextWordCount(PText : PChar; Offset : Integer) : Integer;
var
    Pos : Integer;
    Chars : Integer;
begin
    Pos := Offset;
    while not EndOfText(PText, Pos) do
    begin
        if not IsTextChar(PText, Pos) then Break;
        Chars := NextCharCount(PText, Pos);
        Pos := Pos + Chars;
    end;

    while not EndOfText(PText, Pos) do
    begin
        if IsTextChar(PText, Pos) then Break;
        Chars := NextCharCount(PText, Pos);
        Pos := Pos + Chars;
    end;

    Result := Pos - Offset;
end;

function PrevWordCount(PText : PChar; Offset : Integer) : Integer;
var
    Pos : Integer;
    Chars : Integer;
begin
    Pos := Offset;
    while Pos > 0 do
    begin
        Chars := PrevCharCount(PText, Pos);
        if IsTextChar(PText + Pos - Chars, 0) then Break;
        Pos := Pos - Chars;
    end;

    while Pos > 0 do
    begin
        Chars := PrevCharCount(PText, Pos);
        if not IsTextChar(PText + Pos - Chars, 0) then Break;
        Pos := Pos - Chars;
    end;

    Result := Offset - Pos;
end;

procedure GetTextWidthPos(Dc : Hdc; Metric: TTextMetric; Text : PChar; TextLen : Integer;
                          DrawWidth : Integer; Step : Integer; var Chars : Integer);
var
    TextSize : TSize;
    CharCnt: Integer;
begin
    while true do
    begin
        if (Step > 0) and (Chars = TextLen) then Break;
        if (Step < 0) and (Chars = 0) then Break;
        if (Step > 0) and EofLineChar(Text, Chars) then Break;

        if Step > 0
            then CharCnt := NextCharCount(Text + Chars, 0)
            else CharCnt := -PrevCharCount(Text, Chars);

        Chars := Chars + CharCnt;
        GetTextExtent(Dc, Metric, Text, Chars, TextSize);
        if TextSize.CX > 0 then Inc(TextSize.CX, Metric.tmOverhang);

        if (Step > 0) and (TextSize.CX > DrawWidth) then
        begin
            Chars := Chars - CharCnt;
            Break;
        end
        else if (Step < 0) and (TextSize.CX <= DrawWidth) then
        begin
            Break;
        end;
    end;
end;

procedure PCountChars(Text: PChar; MaxChars, TextLen: Integer; var CharCount, ByteCount: Integer; Reverse: Boolean);
var
    CntChars, CntBytes: Integer;
    TextChars: Integer;
begin
    CharCount := 0;
    ByteCount := 0;
    if (TextLen <= 0) or (MaxChars <= 0) then Exit;

    TextChars := MaxChars;
    if Reverse then
    begin
        PCountChars(Text, TextLen, TextLen, TextChars, CntBytes, False);
        MaxChars := TextChars - MaxChars;
        if MaxChars <= 0 then MaxChars := 0;
    end;

    CntChars := 0;
    CntBytes := 0;
    while (CntBytes < TextLen) and (CntChars < MaxChars) do
    begin
        Inc(CntChars);
        Inc(CntBytes);
        if Text[CntBytes - 1] in LeadBytes then Inc(CntBytes);
    end;

    if Reverse then
    begin
        CharCount := TextChars - CntChars;
        ByteCount := TextLen - CntBytes;
    end
    else
    begin
        CharCount := CntChars;
        ByteCount := CntBytes;
    end;
end;

function PCharToByteLen(Text: PChar; MaxChars, TextLen: Integer; Reverse: Boolean): Integer;
var
    Chars: Integer;
begin
    Result := 0;
    if (MaxChars <= 0) or (TextLen <= 0) then Exit;

    if MaxChars > TextLen then MaxChars := TextLen;
    if tsIsFarEast then
    begin
        PCountChars(Text, MaxChars, TextLen, Chars, Result, Reverse);
        if Result > TextLen then Result := TextLen;
    end
    else
        Result := MaxChars;
end;

function PByteToCharLen(Text: PChar; MaxLen, TextLen: Integer): Integer;
var
    Bytes: Integer;
begin
    Result := 0;
    if (MaxLen <= 0) or (TextLen <= 0) then Exit;

    if MaxLen > TextLen then MaxLen := TextLen;
    Result := MaxLen;
    if tsIsFarEast then PCountChars(Text, MaxLen, MaxLen, Result, Bytes, False);
end;

function GetNextLine(Dc : Hdc; Metric : TTextMetric; Text : PChar; DrawWidth : Integer;
                     Align : TAlignment; var Chars : Integer) : Boolean;
var
    Step : Integer;
    TextSize : TSize;
    Ptr : PChar;
    TextLen : Integer;
    SpaceChars: Integer;
begin
    Chars := 0;
    TextLen := StrLen(Text);

    if TextLen = 0 then
    begin
        Result := false;
        Exit;
    end;

    SpaceChars := 0;
    if (Align = taRightJustify) and IsSpaceChar(Text, 0) then
    begin
        Ptr := StrNSkipSpace(Text, TextLen);
        if Ptr <> nil then
        begin
            SpaceChars := Ptr - Text;
            Text := Ptr;
            TextLen := TextLen - SpaceChars;
        end;
    end;

    Chars := DrawWidth div Metric.tmAveCharWidth;
    Chars := PCharToByteLen(Text, Chars, TextLen, False);

    Ptr := StrNScanEol(Text, Chars);
    if Ptr <> nil then
    begin
        Chars := Ptr - Text;
        GetTextExtent(Dc, Metric, Text, Chars, TextSize);
    end
    else
        GetTextExtent(Dc, Metric, Text, Chars, TextSize);

    if TextSize.CX > 0 then Inc(TextSize.CX, Metric.tmOverhang);
    if TextSize.CX <> DrawWidth then
    begin
        if TextSize.CX < DrawWidth then Step := 1 else Step := -1;
        GetTextWidthPos(Dc, Metric, Text, TextLen, DrawWidth, Step, Chars);
    end;

    if (Chars <> TextLen) and
        not IsSpaceChar(Text, Chars) and
        not EofLineChar(Text, Chars) then
    begin
        Ptr := StrRNSpaceScan(Text, Chars);
        if Ptr <> nil then Chars := Ptr - Text + 1;
    end;

    if (Align = taRightJustify) and (Chars > 0) then
    begin
        if IsSpaceChar(Text, Chars - 1) then
        begin
            Ptr := StrRNTextScan(Text, Chars);
            if Ptr <> nil then Chars := Ptr - Text + NextCharCount(Ptr, 0);
        end;
    end
    else if (Chars < TextLen) then
    begin
        Ptr := StrNSkipSpace(Text + Chars, TextLen - Chars);
        if Ptr = nil
            then Chars := TextLen
            else Chars := Ptr - Text;
    end;

    GetEofLine(Text, Chars);
    if (Chars + SpaceChars = 0) and (TextLen > 0) then Chars := NextCharCount(Text, 0);
    Chars := Chars + SpaceChars;
    Result := (Chars <> 0);