qexport3common.pas

DELPHI开发VCL

      end;
      $0F: begin
        MoveTo(X, Y);
        LineTo(X + 4, Y);

        MoveTo(X, Y);
        LineTo(X, Y + 4);
      end;
      $10: begin
        MoveTo(X, Y);
        LineTo(X + 4, Y + 4);

        MoveTo(X + 2, Y);
        LineTo(X, Y + 2);
      end;
      $11: begin
        MoveTo(X, Y);
        LineTo(X + 1, Y);

        MoveTo(X + 2, Y + 2);
        LineTo(X + 3, Y + 2);
      end;
      $12: begin
        MoveTo(X, Y);
        LineTo(X + 1, Y);

        MoveTo(X + 4, Y + 2);
        LineTo(X + 5, Y + 2);
      end;
    end;
end;

procedure IncLeftAndTop(Control: TControl);
begin
  Control.Left := Control.Left + 1;
  Control.Top := Control.Top + 1;
end;

procedure DecLeftAndTop(Control: TControl);
begin
  Control.Left := Control.Left - 1;
  Control.Top := Control.Top - 1;
end;

procedure PaintSampleFont(AFont: TFont; APaintBox: TPaintBox;
  PaintColor: boolean);
const
  SampleText = 'AaBbCc XxYyZz';
var
  TextLength: integer;
begin
  with APaintBox.Canvas do begin
    Pen.Color := clBlack;
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    Rectangle(0, 0, APaintBox.Width, APaintBox.Height);
    Font.Assign(AFont);
    if not PaintColor then
      Font.Color := clBlack;
    TextLength := TextWidth(SampleText);
    TextOut((APaintBox.Width - TextLength) div 2,
      (APaintBox.Height - TextHeight(SampleText)) div 2, SampleText);
  end;
end;

procedure SelectFontForPaintBox(FontDialog: TFontDialog; AFont: TFont;
  APaintBox: TPaintBox);
begin
  FontDialog.Font.Assign(AFont);
  if FontDialog.Execute then begin
    AFont.Assign(FontDialog.Font);
    APaintBox.Repaint;
  end;
end;

procedure SetListItemIndex(Item: TListItem; Index: integer);

  procedure ChangeTwoItems(Src, Dst: TListItem);
  begin
    Dst.Caption:= Src.Caption;
    Dst.ImageIndex := Src.ImageIndex;
    Dst.Data := Src.Data;
  end;

var
  ListView: TListView;

  FItemCaption: string;
  FItemImageIndex: integer;
  FItemData: Pointer;

  idx, i: integer;
begin
  if Index < 0 then Exit;
  if not Assigned(Item) then Exit;
  idx := Item.Index;
  if idx = Index then Exit;
  ListView := Item.ListView as TListView;
  if not Assigned(ListView.Items[Index]) then Exit;

  FItemCaption := Item.Caption;
  FItemImageIndex := Item.ImageIndex;
  FItemData := Item.Data;

  if idx > Index then
    for i := idx downto Index + 1 do
      ChangeTwoItems(ListView.Items[i - 1], ListView.Items[i]);

  if idx < Index then
    for i := idx to Index - 1 do
      ChangeTwoItems(ListView.Items[i + 1], ListView.Items[i]);

  ListView.Items[Index].Caption:= FItemCaption;
  ListView.Items[Index].ImageIndex := FItemImageIndex;
  ListView.Items[Index].Data := FItemData;
end;

function MoveListItem(Item: TListItem; Dst: TListView; Move: boolean;
  Index: integer): TListItem;
var
  Idx: integer;
  Src: TListView;
begin
  Result := nil;
  if not Assigned(Item) or not Assigned(Dst) then Exit;
  Src := Item.ListView as TListView;
  {$IFDEF WIN32}
  if Index < 0
    then Result := Dst.Items.Add
    else Result := Dst.Items.Insert(Index);
  {$ENDIF}
  {$IFDEF LINUX}
    Result := Dst.Items.Add;
  {$ENDIF}
  Result.Caption := Item.Caption;
  Result.Data := Item.Data;
  Idx := Item.Index;
  if Move then Item.Delete;

  if Src.Items.Count > 0 then begin
    if Idx >= Src.Items.Count
      then Src.Items[Src.Items.Count - 1].Selected := true
      else if Idx < 0
           then Src.Items[0].Selected := true
           else Src.Items[Idx].Selected := true;
  end;
end;
{$ENDIF}

function CalcStringType(const S,
  BooleanTrue, BooleanFalse: string): TQExportColType;
var
  Year, Month, Day: Word;
  Hour, Min, Sec, MSec: Word;
begin
  Result := ectString;
  if S = EmptyStr then Exit;

  //-- IsBoolean
  if (AnsiCompareText(S, BooleanTrue) = 0) or
     (AnsiCompareText(S, BooleanFalse) = 0)  then begin
    Result := ectBoolean;
    Exit;
  end;
  //-- IsInteger
  try StrToInt(S); Result := ectInteger; Exit;
  except end;
  //-- IsFloat
  try StrToFloat(S); Result := ectFloat; Exit;
  except end;
  //-- IsDateTime
  try
    StrToDateTime(S);
    Result := ectDateTime;
    DecodeTime(StrToDateTime(S), Hour, Min, Sec, MSec);
    if (Hour = 0) and (Min = 0) and (Sec = 0) and (MSec = 0) then begin
      Result := ectDate;
      Exit;
    end
    else begin
      DecodeDate(StrToDateTime(S), Year, Month, Day);
      if (Year = 1899) and (Month = 12) and (Day = 30) then begin
        Result := ectTime;
        Exit;
      end;
    end;
  except
  end;
end;

{$IFNDEF NOGUI}
procedure DrawXLSCell(PaintBox: TPaintBox; Format: TxlsFormat);

  procedure OutText;
  const
    TXT = 'Aa Zz';
  var
    X, Y: integer;
    {$IFDEF WIN32}
    USz, UPz, XX: integer;
    otm: TOutlineTextmetric;
    {$ENDIF}
  begin
    with PaintBox.Canvas.Font do begin
      Name := Format.Font.Name;
      Size := Format.Font.Size;
      Charset := Format.Font.Charset;
      Color := XLS_STANDARD_PALETTE[Integer(Format.Font.Color)];
      Style := [];
      if xfsBold in Format.Font.Style
        then Style := Style + [fsBold];
      if xfsItalic in Format.Font.Style
        then Style := Style + [fsItalic];
      if xfsStrikeOut in Format.Font.Style
        then Style := Style + [fsStrikeOut];
    end;

    case Format.Alignment.Horizontal of
      halGeneral,
      halLeft,
      halFill: X := 5;
      halCenter: X := (PaintBox.Width - PaintBox.Canvas.TextWidth(TXT)) div 2;
      halRight: X := PaintBox.Width - 5 - PaintBox.Canvas.TextWidth(TXT);
      else X := 0;
    end;

    case Format.Alignment.Vertical of
      valTop: Y := 5;
      valCenter: Y := (PaintBox.Height - PaintBox.Canvas.TextHeight(TXT)) div 2;
      valBottom: Y := PaintBox.Height - 5 - PaintBox.Canvas.TextHeight(TXT);
      else Y := 0;
    end;

    {$IFDEF WIN32}
    if Format.Font.Underline in [fulNone, fulSingle, fulSingleAccounting] then begin
      PaintBox.Canvas.Brush.Style := bsClear;
      PaintBox.Canvas.TextOut(X, Y, TXT);
    end;
    {$ENDIF}
    {$IFDEF LINUX}
      PaintBox.Canvas.Brush.Style := bsSolid; //bsClear;
      PaintBox.Canvas.TextOut(X, Y, TXT);
    {$ENDIF}

    // Underline
    {$IFDEF WIN32}
    if Format.Font.Underline <> fulNone then begin
      otm.otmSize := SizeOf(otm);
      GetOutlineTextMetrics(PaintBox.Canvas.Handle, otm.otmSize, @otm);
      USz := otm.otmsUnderscoreSize;
      UPz := otm.otmsUnderscorePosition;
      with PaintBox.Canvas do begin
        Pen.Color := Font.Color;
        Pen.Width := otm.otmsUnderscoreSize;
        if Format.Font.Underline in [fulDouble, fulDoubleAccounting] then begin
          case Format.Alignment.Vertical of
            valCenter:
              Y := (PaintBox.Height - PaintBox.Canvas.TextHeight(TXT) -
                USz - 1) div 2;
            valBottom: Y := PaintBox.Height - 5 -
              PaintBox.Canvas.TextHeight(TXT) - USz - 1;
          end;
          if Format.Alignment.Vertical in [valCenter, valBottom] then begin
            PaintBox.Canvas.Brush.Style := bsClear;
            PaintBox.Canvas.TextOut(X, Y, TXT);
          end;
        end;

        case Format.Font.Underline of
          fulSingle: begin
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            LineTo(X + TextWidth(TXT), Y + TextHeight(TXT) + UPz);
          end;
          fulSingleAccounting : begin
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz);
            X := X + USz * 4;
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz);
          end;
          fulDouble: begin
            MoveTo(X, Y + TextHeight(TXT) + Upz);
            LineTo(X + TextWidth(TXT), Y + TextHeight(TXT) + UPz);
            MoveTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
            LineTo(X + TextWidth(TXT), Y + TextHeight(TXT) + UPz + USz + 1);
          end;
          fulDoubleAccounting: begin
            XX := X;
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz);
            X := X + USz * 4;
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz);

            X := XX;
            MoveTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
            X := X + USz * 4;
            MoveTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
          end;
        end;
      end;
    end
    {$ENDIF}
  end;

  procedure DrawBorderLine(X1, Y1, X2, Y2: integer; Border: TxlsBorder);
  begin
    with PaintBox.Canvas do begin
      Pen.Style := psSolid;
      Pen.Color := ColorByXLSColor(Border.Color);

      case Border.Style of
        bstThin, bstDashed, bstDotted,
        bstDouble, bstHair, bstDashDot,
        bstDashDotDot: Pen.Width := 1;

        bstMedium, bstMediumDashed,
        bstMediumDashDot, bstMediumDashDotDot,
        bstSlantedDashDot: Pen.Width := 2;

        bstThick: Pen.Width := 3;
      end;

      case Border.Style of
        bstThin,
        bstMedium,
        bstThick: begin
          MoveTo(X1, Y1);
          LineTo(X2, Y2);
        end;

        bstDashed,
        bstMediumDashed,
        bstDashDot,
        bstMediumDashDot,
        bstSlantedDashDot,
        bstDashDotDot,
        bstMediumDashDotDot: begin
          if X2 > X1 then
            while X2 - X1 > 5 do begin
              MoveTo(X1, Y1);
              if X2 > X1 then
                if X2 - X1 >= 10
                  then LineTo(X1 + 10, Y1)
                  else LineTo(X2, Y1);
              Inc(X1, 15);

              if Border.Style in [bstDashDot, bstMediumDashDot,
              bstSlantedDashDot, bstDashDotDot, bstMediumDashDotDot] then begin
                MoveTo(X1, Y1);
                if X2 > X1 then
                  if X2 - X1 >= 2
                    then LineTo(X1 + 2, Y1)
                    else LineTo(X2, Y1);
                Inc(X1, 7);
              end;

              if Border.Style in [bstDashDotDot, bstMediumDashDotDot] then begin
                MoveTo(X1, Y1);
                if X2 > X1 then
                  if X2 - X1 >= 2
                    then LineTo(X1 + 2, Y1)
                    else LineTo(X2, Y1);
                Inc(X1, 7);
              end;

            end;

          if Y2 > Y1 then
            while Y2 - Y1 > 5 do begin
              MoveTo(X1, Y1);
              if Y2 > Y1 then
                if Y2 - Y1 >= 10
                  then LineTo(X1, Y1 + 10)
                  else LineTo(X1, Y2);
              Inc(Y1, 15);

              if Border.Style in [bstDashDot, bstMediumDashDot,
              bstSlantedDashDot, bstDashDotDot, bstMediumDashDotDot] then begin
                MoveTo(X1, Y1);
                if Y2 > Y1 then
                  if Y2 - Y1 >= 2
                    then LineTo(X1, Y1 + 2)
                    else LineTo(X1, Y2);
                Inc(Y1, 7);
              end;

              if Border.Style in [bstDashDotDot, bstMediumDashDotDot] then begin
                MoveTo(X1, Y1);
                if Y2 > Y1 then
                  if Y2 - Y1 >= 2
                    then LineTo(X1, Y1 + 2)
                    else LineTo(X1, Y2);
                Inc(Y1, 7);
              end;

            end;
        end;

        bstDotted,
        bstHair: begin
          if X2 > X1 then
            while X2 - X1 > 1 + Integer(Border.Style = bstDotted) do begin
              MoveTo(X1, Y1);
              if X2 - X1 >= 1 + Integer(Border.Style = bstDotted)
                then LineTo(X1 + 1 + Integer(Border.Style = bstDotted), Y1)
                else LineTo(X2, Y1);
              Inc(X1, 3 + 2 * Integer(Border.Style = bstDotted));
            end;

          if Y2 > Y1 then
            while Y2 - Y1 > 1 + Integer(Border.Style = bstDotted) do begin
              MoveTo(X1, Y1);
              if Y2 - Y1 >= 1 + Integer(Border.Style = bstDotted)
                then LineTo(X1, Y1 + 1 + Integer(Border.Style = bstDotted))
                else LineTo(X1, Y2);
              Inc(Y1, 3 + 2 * Integer(Border.Style = bstDotted));
            end;
        end;

        bstDouble: begin
          if X1 <> X2 then begin