qexport4dsgn.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

      DataSet := TDataSet(TypInfo.GetOrdProp(Holder, PropInfo));
      if not Assigned(DataSet) then Exit;

      WasInActive :=  not Dataset.Active;
      if WasInActive then
      try
        Dataset.Open;
      except
        Exit;
      end;
      for i := 0 to DataSet.FieldCount - 1 do begin
        Proc(DataSet.Fields[I].FieldName);
      end;
      if WasInActive then
      try
        Dataset.Close;
      except
      end;
    end; //esDataSet
    esDBGrid: begin
      PropInfo := TypInfo.GetPropInfo(Holder.ClassInfo, 'DBGrid');
      if not Assigned(PropInfo) then Exit;
      DBGrid := TDBGrid(TypInfo.GetOrdProp(Holder, PropInfo));
      if not Assigned(DBGrid) then Exit;

      if DBGrid.Columns.Count > 0 then begin
        for i := 0 to DBGrid.Columns.Count - 1 do begin
          Proc(DBGrid.Columns[i].Title.Caption);
        end;
      end
      else if Assigned(DBGrid.DataSource) and
              Assigned(DBGrid.DataSource.DataSet) then begin
        DataSet := DBGrid.DataSource.DataSet;
        WasInActive :=  not Dataset.Active;
        if WasInActive then
        try
          Dataset.Open;
        except
          Exit;
        end;
        for i := 0 to DataSet.FieldCount - 1 do begin
          Proc(DataSet.Fields[I].FieldName);
        end;
        if WasInActive then
        try
          Dataset.Close;
        except
        end;
        end;
    end; //esDBGrid
    esListView: begin
      PropInfo := TypInfo.GetPropInfo(Holder.ClassInfo, 'ListView');
      if not Assigned(PropInfo) then Exit;
      ListView := TListView(TypInfo.GetOrdProp(Holder, PropInfo));
      if not Assigned(ListView) then Exit;

      for i := 0 to ListView.Columns.Count - 1 do begin
        Proc(ListView.Columns[i].Caption);
      end;
    end;//esListView
    esStringGrid: begin
      PropInfo := TypInfo.GetPropInfo(Holder.ClassInfo, 'StringGrid');
      if not Assigned(PropInfo) then Exit;
      StringGrid := TStringGrid(TypInfo.GetOrdProp(Holder, PropInfo));
      if not Assigned(StringGrid) then Exit;

      for i := 0 to StringGrid.ColCount - 1 do begin
        Proc(IntToStr(i));
      end;
    end;//esStringGrid;
  end;}
end;

{ TQDatabaseNameProperty }

{$IFDEF ADO}
function TQDatabaseNameProperty.GetFilter: string;
begin
  Result := 'MS Access files (*.mdb)|*.mdb';
end;

function TQDatabaseNameProperty.GetDefaultExt: string;
begin
  Result := 'mdb';
end;
{$ENDIF}

{ TxlsColorProperty }

const
  xlsColors: array[0..39] of TIdentMapEntry = (
    (Value: Integer(clrBlack); Name: 'clrBlack'),
    (Value: Integer(clrBrown); Name: 'clrBrown'),
    (Value: Integer(clrOliveGreen); Name: 'clrOliveGreen'),
    (Value: Integer(clrDarkGreen); Name: 'clrDarkGreen'),
    (Value: Integer(clrDarkTeal); Name: 'clrDarkTeal'),
    (Value: Integer(clrDarkBlue); Name: 'clrDarkBlue'),
    (Value: Integer(clrIndigo); Name: 'clrIndigo'),
    (Value: Integer(clrGray80Percent); Name: 'clrGray80Percent'),
    (Value: Integer(clrDarkRed); Name: 'clrDarkRed'),
    (Value: Integer(clrOrange); Name: 'clrOrange'),
    (Value: Integer(clrDarkYellow); Name: 'clrDarkYellow'),
    (Value: Integer(clrGreen); Name: 'clrGreen'),
    (Value: Integer(clrTeal); Name: 'clrTeal'),
    (Value: Integer(clrBlue); Name: 'clrBlue'),
    (Value: Integer(clrBlueGray); Name: 'clrBlueGray'),
    (Value: Integer(clrGray50Percent); Name: 'clrGray50Percent'),
    (Value: Integer(clrRed); Name: 'clrRed'),
    (Value: Integer(clrLightOrange); Name: 'clrLightOrange'),
    (Value: Integer(clrLime); Name: 'clrLime'),
    (Value: Integer(clrSeaGreen); Name: 'clrSeaGreen'),
    (Value: Integer(clrAqua); Name: 'clrAqua'),
    (Value: Integer(clrLightBlue); Name: 'clrLightBlue'),
    (Value: Integer(clrViolet); Name: 'clrViolet'),
    (Value: Integer(clrGray40Percent); Name: 'clrGray40Percent'),
    (Value: Integer(clrPink); Name: 'clrPink'),
    (Value: Integer(clrGold); Name: 'clrGold'),
    (Value: Integer(clrYellow); Name: 'clrYellow'),
    (Value: Integer(clrBrightGreen); Name: 'clrBrightGreen'),
    (Value: Integer(clrTurquoise); Name: 'clrTurquoise'),
    (Value: Integer(clrSkyBlue); Name: 'clrSkyBlue'),
    (Value: Integer(clrPlum); Name: 'clrPlum'),
    (Value: Integer(clrGray25Percent); Name: 'clrGray25Percent'),
    (Value: Integer(clrRose); Name: 'clrRose'),
    (Value: Integer(clrTan); Name: 'clrTan'),
    (Value: Integer(clrLightYellow); Name: 'clrLightYellow'),
    (Value: Integer(clrLihtGreen); Name: 'clrLihtGreen'),
    (Value: Integer(clrLightTurquoise); Name: 'clrLightTurquoise'),
    (Value: Integer(clrPaleBlue); Name: 'clrPaleBlue'),
    (Value: Integer(clrLavender); Name: 'clrLavender'),
    (Value: Integer(clrWhite); Name: 'clrWhite'));

function ExcelColorToIdent(xlsColor: TxlsColor; var Ident: string): Boolean;
begin
  Result := IntToIdent(Integer(xlsColor), Ident, xlsColors);
end;

function IdentToExcelColor(const Ident: string; var xlsColor: TxlsColor): Boolean;
var
  iColor: integer;
begin
  iColor := Integer(xlsColor);
  Result := IdentToInt(Ident, iColor, xlsColors);
  xlsCOlor := TxlsColor(iColor);
end;

function ExcelColorToString(Color: TxlsColor): string;
begin
  ExcelColorToIdent(Color, Result);
end;

{$IFDEF VCL5}
function StringToExcelColor(const S: string): TxlsColor;
begin
  if not IdentToExcelColor(S, Result) then
    Result := clrBlack;
end;

function ExcelColorToColor(Color: TxlsColor): TColor;
begin
  Result := XLS_STANDARD_PALETTE[Integer(Color)];
end;
{$ENDIF}

procedure TxlsColorProperty.Edit;
var
  OClr, NClr: TxlsColor;
begin
  OClr := TxlsColor(GetOrdValue);
  NClr := RunXLSColorEditor(OClr);
  if NClr <> OClr then begin
    SetOrdValue(Integer(NClr));
    SetStrValue(ExcelColorToString(NClr));
  end;
end;

function TxlsColorProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog, paValueList, paRevertable];
end;

function TxlsColorProperty.GetValue: string;
begin
  Result := ExcelColorToString(TxlsColor(GetOrdValue));
end;

procedure TxlsColorProperty.GetValues(Proc: TGetStrProc);
var
  i: integer;
begin
  for i := Integer(Low(TxlsColor)) to Integer(High(TxlsColor)) do
    Proc(xlsColors[i].Name);
end;

{$IFDEF VCL5}
procedure TxlsColorProperty.ListDrawValue(const Value: string;
  ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);

  function ColorToBorderColor(AColor: TxlsColor): TColor;
  type
    TColorQuad = record
      Red,
      Green,
      Blue,
      Alpha: Byte;
    end;
  var
    FColor: TColor;
  begin
    FColor := ExcelColorToColor(AColor);
    if (TColorQuad(FColor).Red > 192) or
       (TColorQuad(FColor).Green > 192) or
       (TColorQuad(FColor).Blue > 192) then
      Result := clBlack
    else if ASelected then
      Result := clWhite
    else
      Result := ExcelColorToColor(AColor);
  end;
  
var
  vRight: Integer;
  vOldPenColor, vOldBrushColor: TColor;
begin
  vRight := (ARect.Bottom - ARect.Top) {* 2} + ARect.Left;
  with ACanvas do
  try
    // save off things
    vOldPenColor := Pen.Color;
    vOldBrushColor := Brush.Color;

    // frame things
    Pen.Color := Brush.Color;
    Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);

    // set things up and do the work
    Brush.Color := ExcelColorToColor(StringToExcelColor(Value));
    Pen.Color := ColorToBorderColor(StringToExcelColor(Value));
    Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);

    // restore the things we twiddled with
    Brush.Color := vOldBrushColor;
    Pen.Color := vOldPenColor;
  finally
    {$IFDEF VCL6}
    DefaultPropertyListDrawValue(Value, ACanvas, Rect(vRight, ARect.Top,
      ARect.Right, ARect.Bottom), ASelected);
    {$ELSE}
    inherited ListDrawValue(Value, ACanvas, Rect(vRight, ARect.Top, ARect.Right,
      ARect.Bottom), ASelected);
    {$ENDIF}
  end;
end;
{$ENDIF}

{$IFDEF VCL5}
procedure TxlsColorProperty.ListMeasureWidth(const Value: string;
  ACanvas: TCanvas; var AWidth: Integer);
begin
  AWidth := AWidth + ACanvas.TextHeight('M') {* 2};
end;
{$ENDIF}

{$IFDEF VCL6}
procedure TxlsColorProperty.ListMeasureHeight(const Value: string;
  ACanvas: TCanvas; var AHeight: Integer);
begin
  // No implemenation necessary
end;
{$ENDIF}

{$IFDEF VCL5}
procedure TxlsColorProperty.PropDrawValue(ACanvas: TCanvas;
  const ARect: TRect; ASelected: Boolean);
begin
  if GetVisualValue <> '' then
    ListDrawValue(GetVisualValue, ACanvas, ARect, True{ASelected})
  else
  {$IFDEF VCL6}
  DefaultPropertyDrawValue(Self, ACanvas, ARect);
  {$ELSE}
  inherited PropDrawValue(ACanvas, ARect, ASelected);
  {$ENDIF}
end;
{$ENDIF}

{$IFDEF VCL6}
procedure TxlsColorProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect;
  ASelected: Boolean);
begin
  DefaultPropertyDrawName(Self, ACanvas, ARect);
end;
{$ENDIF}

procedure TxlsColorProperty.SetValue(const Value: string);
var
  NewValue: TxlsColor;
begin
  if IdentToExcelColor(Value, NewValue) then
    SetOrdValue(Integer(NewValue))
  else inherited SetValue(Value);
end;

{ TQHTMLBkgFileNameProperty }

function TQHTMLBkgFileNameProperty.GetDefaultExt: string;
begin
  Result := 'jpg';
end;

function TQHTMLBkgFileNameProperty.GetFilter: string;
begin
  Result := 'Graphics files (*.jpg, *.jpeg, *.gif, *.png)|*.jpg;*.jpeg;*.gif;*.png|All files (*.*)|*.*';
end;

{ TQODSFileNameProperty }

function TQODSFileNameProperty.GetDefaultExt: string;
begin
  Result := 'ods';
end;

function TQODSFileNameProperty.GetFilter: string;
begin
  Result := 'ODS files (*.ods)|*.ods';
end;

{ TQODTFileNameProperty }

function TQODTFileNameProperty.GetDefaultExt: string;
begin
  Result := 'odt';
end;

function TQODTFileNameProperty.GetFilter: string;
begin
  Result := 'ODT files (*.odt)|*.odt';
end;

{ TQExportODSEditor }

procedure TQExportODSEditor.Edit;
begin
  ExecuteVerb(0);
end;

procedure TQExportODSEditor.ExecuteVerb(Index: integer);
begin
  case Index of
    0: if RunQExportODSEditor(Component as TQExport4ODS)
         then Designer.Modified;
    1: ShowAboutForm;
  end;
end;

function TQExportODSEditor.GetVerb(Index: integer): string;
begin
  case Index of
    0: Result := 'Component editor...';
    1: Result := '&About EMS QuickExport...';
  end;
end;

function TQExportODSEditor.GetVerbCount: integer;
begin
  Result := 2;
end;

{ TQExportODTEditor }

procedure TQExportODTEditor.Edit;
begin
  ExecuteVerb(0);
end;

procedure TQExportODTEditor.ExecuteVerb(Index: integer);
begin
  case Index of
    0: if RunQExportODTEditor(Component as TQExport4ODT)
         then Designer.Modified;
    1: ShowAboutForm;
  end;
end;

function TQExportODTEditor.GetVerb(Index: integer): string;
begin
  case Index of
    0: Result := 'Component editor...';
    1: Result := '&About EMS QuickExport...';
  end;
end;

function TQExportODTEditor.GetVerbCount: integer;
begin
  Result := 2;
end;

{ TQExportXlsxEditor }

function TQExportXlsxEditor.GetVerbCount: integer;
begin
  Result := 2;
end;

function TQExportXlsxEditor.GetVerb(Index: integer): string;
begin
  case Index of
    0: Result := 'Component editor...';
    1: Result := '&About EMS QuickExport...';
  end;
end;

procedure TQExportXlsxEditor.ExecuteVerb(Index: integer);
begin
  case Index of
    0: if RunQExportXlsxEditor(Component as TQExport4Xlsx)
         then Designer.Modified;
    1: ShowAboutForm;
  end;
end;

procedure TQExportXlsxEditor.Edit;
begin
  ExecuteVerb(0);
end;

{ TQExportDocxEditor }

function TQExportDocxEditor.GetVerbCount: integer;
begin
  Result := 2;
end;

function TQExportDocxEditor.GetVerb(Index: integer): string;
begin
  case Index of
    0: Result := 'Component editor...';
    1: Result := '&About EMS QuickExport...';
  end;
end;

procedure TQExportDocxEditor.ExecuteVerb(Index: integer);
begin
  case Index of
    0: if RunQExportDocxEditor(Component as TQExport4Docx)
         then Designer.Modified;
    1: ShowAboutForm;
  end;
end;

procedure TQExportDocxEditor.Edit;
begin
  ExecuteVerb(0);
end;

end.