cxexport.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,045 行 · 第 1/3 页

function cxExtractFileNameExW(const AFileName: WideString): WideString;
begin
  Result := CopyEx(AFileName, GetLastDelimiterPos(AFileName, '\'));
end;

function cxExtractFilePathExW(const AFileName: WideString): WideString;
begin
  Result := CopyEx(AFileName, 1, GetLastDelimiterPos(AFileName, '\') - 1);
end;

function cxValidateFileName(const AFileName: string): WideString;
begin
  Result := cxValidateFileNameW(cxStrToUnicode(AFileName));
end;

function cxValidateFileNameW(const AFileName: WideString): WideString;
begin
  Result := AFileName;
  while Pos('/', Result) <> 0 do
    Result[Pos('/', Result)] := '\';
end;

procedure UseGraphicImages(AUse: Boolean);
begin
  if AUse then
    Inc(GraphicRef)
  else
    Dec(GraphicRef);
  if GraphicRef = 0 then
    GraphicCount := 0;
end;

function CreateDefaultCellStyle: TcxCacheCellStyle;
var
  I: Integer;
begin
  with Result do
  begin
    AlignText := catCenter;
    FillChar(FontName, SizeOf(FontName), 0);
    FontName := 'Tahoma';
    FontStyle := [];
    FontColor := cxBtnTextColor;
    FontSize := 8;
    FontCharSet := 0;
    for I := 0 to 3 do
    begin
      Borders[I].IsDefault := False;
      Borders[I].Width := 1;
      Borders[I].Color := cxBtnShadowColor;
    end;
    BrushStyle := cbsSolid;
    BrushBkColor := cxWindowColor;
    BrushFgColor := cxBlackColor;
  end;
end;

function cxColorToRGB(const AColor: Integer): Integer;
type
  TRGB = packed record
    R, G, B, A: Byte;
  end;

begin
  Result := cxGetRgbColor(AColor);
  if IsNativeColor then Exit;
  with TRGB(cxGetRgbColor(AColor)) do
  begin
    if AColor < 0 then 
      Result := R shl 16 + G shl 8 + B;
  end;
end;

{$IFDEF WIN32}
function cxUnicodeToStr(const AText: WideString; ACharset: Integer = 0): string;
var
  APage, ALen: Integer;
begin
  case ACharset of
    THAI_CHARSET:
      APage := 874;
    SHIFTJIS_CHARSET:
      APage := 932;
    GB2312_CHARSET:
      APage := 936;
    HANGEUL_CHARSET, JOHAB_CHARSET:
      APage := 949;
    CHINESEBIG5_CHARSET:
      APage := 950;
    EASTEUROPE_CHARSET:
      APage := 1250;
    RUSSIAN_CHARSET:
      APage := 1251;
    GREEK_CHARSET:
      APage := 1253;
    TURKISH_CHARSET:
      APage := 1254;
    HEBREW_CHARSET:
      APage := 1255;
    ARABIC_CHARSET:
      APage := 1256;
    BALTIC_CHARSET:
      APage := 1257;
  else
    APage := 0
  end;
  ALen := WideCharToMultiByte(APage, 0, PWideChar(AText), Length(AText), nil, 0, nil, nil);
  SetLength(Result, ALen);
  WideCharToMultiByte(APage, 0, PWideChar(AText), Length(AText), PChar(Result), ALen, nil, nil);
end;

function cxStrToUnicode(const AText: string; ACharset: Integer = 0): Widestring;
var
  APage, ALen: Integer;
begin
  case ACharset of
    THAI_CHARSET:
      APage := 874;
    SHIFTJIS_CHARSET:
      APage := 932;
    GB2312_CHARSET:
      APage := 936;
    HANGEUL_CHARSET, JOHAB_CHARSET:
      APage := 949;
    CHINESEBIG5_CHARSET:
      APage := 950;
    EASTEUROPE_CHARSET:
      APage := 1250;
    RUSSIAN_CHARSET:
      APage := 1251;
    GREEK_CHARSET:
      APage := 1253;
    TURKISH_CHARSET:
      APage := 1254;
    HEBREW_CHARSET:
      APage := 1255;
    ARABIC_CHARSET:
      APage := 1256;
    BALTIC_CHARSET:
      APage := 1257;
  else
    APage := 0
  end;
  ALen := MultiByteToWideChar(APage, 0, PChar(AText), Length(AText), nil, 0);
  SetLength(Result, ALen);
  MultiByteToWideChar(APage, 0, PChar(AText), Length(AText), PWideChar(Result), ALen);
end;
{$ELSE}
function cxStrToUnicode(const AText: string; ACharset: Integer = 0): Widestring;
begin
  Result := AText;
end;
{$ENDIF}

function cxStrUnicodeNeeded(const AText: string; ACheckNormal: Boolean = False): Boolean;
var
  I: Integer;
const
  ANormal = ['0'..'9', ':', ';', '*', '+', ',', '-', '.', '/', '!', ' ',
    'A'..'Z', 'a'..'z', '_', '(', ')'];
begin
  Result := False;
  for I := 1 to Length(AText) do
    if (Byte(AText[I]) > $7F) or (ACheckNormal and not (AText[I] in ANormal)) then
    begin
      Result := True;
      Break;
    end
end;

function GetHashCode(const Buffer; Count: Integer): Integer; assembler;
asm
        MOV     ECX, EDX
        MOV     EDX, EAX
        XOR     EAX, EAX
@@1:    ROL     EAX, 5
        XOR     AL, [EDX]
        INC     EDX
        DEC     ECX
        JNE     @@1
end;

function GetGraphicFileName(const AFileName, AExt: string): string;
begin
  Result := ChangeFileExt(AFileName, '.images') + '\' + ChangeFileExt(
    ExtractFileName(AFileName), '') + '_' + IntToStr(GraphicCount) + '.' + AExt;
  Inc(GraphicCount);
end;

function PrepareGraphic(AGraphic: TGraphic): TGraphic;
begin
  Result := AGraphic;
  if not SupportGraphic(cxExportGraphicClass) then
  begin
    Result := cxExportGraphicClass.Create;
    try
      try
        Result.Assign(AGraphic);
      except
        Result.Free;
        Result := AGraphic;
      end;
    finally
      if Result <> AGraphic then
        AGraphic.Free;
    end;
  end;
end;

function SupportGraphic(AGraphic: TGraphic): Boolean;
begin
  Result := SupportGraphic(TGraphicClass(AGraphic.ClassType));
end;

function SupportGraphic(AGraphicClass: TGraphicClass): Boolean;
begin
  Result := (AGraphicClass <> nil) and
   (AGraphicClass.InheritsFrom(TBitmap) or
    AGraphicClass.InheritsFrom(TMetaFile));
end;

procedure GetGraphicAsText(const AFileName: string;
  var AGraphic: TGraphic; var AGraphicText: string);
var
  L: Integer;
  AName: string;
  AMemStream: TMemoryStream;
begin
  AGraphic := PrepareGraphic(AGraphic);
  AName := GetGraphicFileName(AFileName,
    GraphicExtension(TGraphicClass(AGraphic.ClassType)));
  AMemStream := TMemoryStream.Create;
  try
    AGraphic.SaveToStream(AMemStream);
    L := Length(AName);
    SetLength(AGraphicText, AMemStream.Size + L + SizeOf(L));
    Move(L, AGraphicText[1], SizeOf(L));
    Move(AName[1], AGraphicText[1 + SizeOf(L)], L);
    Move(AMemStream.Memory^, AGraphicText[1 + SizeOf(L) + L], AMemStream.Size);
  finally
    AMemStream.Free;
  end;
end;

procedure GetTextAsGraphicStream(const AText: string; var AFileName, AStream: string);
var
  L: Integer;
begin
  Move(AText[1], L, SizeOf(L));
  SetLength(AFileName, L);
  Move(AText[1 + SizeOf(L)], AFileName[1], L);
  SetLength(AStream, Length(AText) - SizeOf(L) - L);
  Move(AText[1 + SizeOf(L) + L], AStream[1], Length(AStream));
end;

{$IFNDEF DELPHI5}
procedure FreeAndNil(var Obj);
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;

function Supports(Instance: TObject; const Intf: TGUID; out Inst): Boolean;
begin
  Result := (Instance <> nil) and Instance.GetInterface(Intf, Inst);
end;
{$ENDIF}

{ TcxExport }
class function TcxExport.Provider(AExportType: Integer;
  const AFileName: string): TcxCustomExportProvider;
begin
  Result := GetExportClassByType(AExportType).Create(AFileName);
end;

class procedure TcxExport.SupportExportTypes(
  EnumSupportTypes: TcxEnumExportTypes);
var
  I: Integer;
begin
  for I := 0 to Length(RegisteredClasses) - 1  do
  begin
    with RegisteredClasses[I] do
      EnumSupportTypes(ExportType, ExportName);
  end;
end;

class procedure TcxExport.SupportTypes(EnumFunc: TcxEnumTypes);
var
  I: Integer;
begin
  for I := 0 to Length(RegisteredClasses) - 1 do
    EnumFunc(RegisteredClasses[I].ExportType);
end;

class function TcxExport.RegisterProviderClass(AProviderClass: TcxExportProviderClass): Boolean;
var
  I: Integer;
begin
  Result := False;
  if AProviderClass = nil then
    Exit;
  for I := 0 to Length(RegisteredClasses) - 1 do
  begin
    if (AProviderClass.ExportType = RegisteredClasses[I].ExportType) or
      (AProviderClass = RegisteredClasses[I]) then Exit;
  end;
  I := Length(RegisteredClasses);
  SetLength(RegisteredClasses, I + 1);
  RegisteredClasses[I] := AProviderClass;
  Result := True;
end;

class function TcxExport.GetExportClassByType(
  AExportType: Integer): TcxExportProviderClass;
var
  I: Integer;
begin
  for I := 0 to Length(RegisteredClasses) - 1 do
  begin
    if RegisteredClasses[I].ExportType = AExportType then
    begin
      Result := RegisteredClasses[I];
      Exit;
    end;
  end;
  raise EcxExportData.CreateFmt(cxGetResString(@scxUnsupportedExport), [AExportType]);
end;

{ TcxCustomExportProvider }
constructor TcxCustomExportProvider.Create(const AFileName: string);
begin
  FFileName := cxValidateFileName(AFileName);
end;

procedure TcxCustomExportProvider.BeforeDestruction;
begin
  Clear;
end;

class function TcxCustomExportProvider.ExportType: Integer;
begin
  Result := -1;
end;

class function TcxCustomExportProvider.ExportName: string;