teeurl.pas

BCB第三方组件

  With TIdHttp.Create(nil) do
  try
    Get(string(AURL),ToStream);
    ToStream.Position:=0;
    result:=0;
  finally
    Free;
  end;
  {$ENDIF}
end;
{$ENDIF}

function TeeURLErrorMessage(ErrorCode: Integer): string;
{$IFNDEF CLX}
var
  Len    : Integer;
  Buffer : {$IFDEF CLR}StringBuilder{$ELSE}TeeString256{$ENDIF};
{$ENDIF}
begin
  {$IFDEF CLX}
  result:=IntToStr(ErrorCode);
  {$ELSE}

  {$IFDEF CLR}
  Buffer:=StringBuilder.Create(256);
  Len:=0;
  {$ENDIF}

  {$IFNDEF CLR}
  Len := FormatMessage(FORMAT_MESSAGE_FROM_HMODULE or
                       FORMAT_MESSAGE_ARGUMENT_ARRAY,
                       {$IFDEF CLR}IntPtr{$ELSE}Pointer{$ENDIF}(TeeWinInetDLL),
                       ErrorCode, 0, Buffer,
                       SizeOf(Buffer), nil);
  while (Len > 0) and ({$IFDEF CLR}AnsiChar{$ENDIF}(Buffer[Len - 1]) in [#0..#32, '.']) do Dec(Len);
  {$ENDIF}

  {$IFDEF CLR}
  result:=Buffer.ToString(0,Len);
  {$ELSE}
  SetString(result, Buffer, Len);
  {$ENDIF}
  {$ENDIF}
end;

// Returns True when "St" is suspicious to contain a web address...
Function TeeIsURL(St:String):Boolean;
begin
  St:=UpperCase(Trim(St));
  result:=(Pos('HTTP://',St)>0) or (Pos('FTP://',St)>0);
end;

{ TTeeSeriesSourceFile }
Procedure TTeeSeriesSourceFile.Load;
begin
  if Assigned(Series) and (FileName<>'') then
     if TeeIsURL(FileName) then LoadFromURL(FileName)
                           else LoadFromFile(FileName);
end;

procedure TTeeSeriesSourceFile.SetFileName(const Value: String);
begin
  if FFileName<>Value then
  begin
    Close;
    FFileName:=Value;
  end;
end;

procedure TTeeSeriesSourceFile.LoadFromFile(const AFileName: String);
var tmp : TFileStream;
begin
  tmp:=TFileStream.Create(AFileName,fmOpenRead);
  try
    LoadFromStream(tmp);
  finally
    tmp.Free;
  end;
end;

procedure TTeeSeriesSourceFile.LoadFromURL(const AURL: String);
var Stream : TMemoryStream;
    tmpURL : String;
    tmp    : Integer;
begin
  Stream:=TMemoryStream.Create;
  try
    tmpURL:=AURL;
    tmp:=DownloadURL({$IFNDEF CLR}PChar{$ENDIF}(tmpURL),Stream);
    if tmp=0 then LoadFromStream(Stream)
    else
      Raise ChartException.CreateFmt(TeeMsg_CannotLoadSeriesDataFromURL,
          [tmp,AURL+' '+TeeURLErrorMessage(tmp)]);
  finally
    Stream.Free;
  end;
end;

procedure TTeeSeriesSourceFile.LoadFromStream(AStream: TStream);
begin
  if not Assigned(Series) then
     Raise Exception.Create(TeeMsg_NoSeriesSelected);
end;

{ TCustomChartLink }
procedure TCustomChartLink.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) and Assigned(FChart) and (AComponent=FChart) then
     Chart:=nil;
end;

procedure TCustomChartLink.SetChart(const Value: TCustomChart);
begin
  if FChart<>Value then
  begin
    {$IFDEF D5}
    if Assigned(FChart) then
       FChart.RemoveFreeNotification(Self);
    {$ENDIF}

    FChart:=Value;

    if Assigned(FChart) then
       FChart.FreeNotification(Self);
  end;
end;

{ TChartWebSource }
Constructor TChartWebSource.Create(AOwner: TComponent);
begin
  inherited {$IFDEF CLR}Create(AOwner){$ENDIF};
  FURL:=TeeMsg_DefaultDemoTee;
end;

procedure TChartWebSource.Execute;
begin
  if FURL<>'' then
     LoadFromURL(FURL);
end;

type
  TCachedStream=class
  public
    URL : String;
    Stream : TMemoryStream;
    Constructor Create;
    Destructor Destroy; override;
  end;

var
  Cached : TList;

{ TCachedImage }

Constructor TCachedStream.Create;
begin
  inherited;
  Stream:=TMemoryStream.Create;
end;

Destructor TCachedStream.Destroy;
begin
  Stream.Free;
  inherited;
end;

procedure DestroyCachedStreams;
var t : Integer;
begin
  for t:=0 to Cached.Count-1 do
      TCachedStream(Cached[t]).Free;
end;

Function CacheDownload(Const URL:String; St:TStream):Integer;
var tmpUrl : String;
    t      : Integer;
    NewCached : TCachedStream;
begin
  tmpUrl:=UpperCase(url);
  for t:=0 to Cached.Count-1 do
  if UpperCase(TCachedStream(Cached[t]).URL)=tmpUrl then
  begin
    TCachedStream(Cached[t]).Stream.SaveToStream(St);
    result:=0;
    exit;
  end;

  NewCached:=TCachedStream.Create;
  NewCached.URL:=tmpUrl;
  result:=DownloadURL({$IFNDEF CLR}PAnsiChar{$ENDIF}(url),NewCached.Stream);

  if result=0 then
  begin
    NewCached.Stream.Position:=0;
    NewCached.Stream.SaveToStream(St);
    Cached.Add(NewCached);
  end
  else NewCached.Free;
end;

{ TImportChart }
Constructor TImportChart.Create(AOwner: TComponent);
begin
  inherited;
  FKeepPosition:=True;
  FKeepSize:=True;
end;

procedure TImportChart.LoadFromFile(const FileName: String);
var f : TFileStream;
begin
  f:=TFileStream.Create(FileName,fmOpenRead);
  try
    LoadFromStream(f);
  finally
    f.Free;
  end;
end;

procedure TImportChart.CheckChart;
begin
  if not Assigned(FChart) then
     raise ChartException.Create('Chart not assigned. Cannot import.');
end;

procedure TImportChart.CheckPosition(const Rect:TRect);
begin
  if KeepPosition or KeepSize then
     FChart.Align:=alNone;

  if KeepPosition then
  begin
    FChart.Left:=Rect.Left;
    FChart.Top:=Rect.Top;
  end;

  if KeepSize then
  begin
    FChart.Width:=(Rect.Right-Rect.Left);
    FChart.Height:=(Rect.Bottom-Rect.Top);
  end;
end;

procedure TImportChart.LoadFromStream(const Stream: TStream);
var tmpR : TRect;
begin
  CheckChart;

  if Assigned(FOnLoading) then
     FOnLoading(Self);

  tmpR:=FChart.BoundsRect;
  try
    LoadChartFromStream(FChart,Stream);
  finally
    CheckPosition(tmpR);
  end;

  if Assigned(FOnLoaded) then
     FOnLoaded(Self);
end;

procedure TImportChart.LoadFromURL(const URL: String);
var tmpR : TRect;
begin
  CheckChart;

  if Assigned(FOnLoading) then
     FOnLoading(Self);

  tmpR:=FChart.BoundsRect;
  try
    LoadChartFromURL(FChart,URL);
  finally
    CheckPosition(tmpR);
  end;

  if Assigned(FOnLoaded) then
     FOnLoaded(Self);
end;

initialization
  {$IFNDEF CLR}
  {$IFNDEF CLX}
  {$IFDEF C3}
  TeeWinInetDLL:=0; { <-- BCB3 crashes in Win95 if we do not do this... }
  {$ENDIF}
  {$ENDIF}
  {$ENDIF}
  Cached:=TList.Create;
  TeeHtml.GraphicDownload:=CacheDownload;
finalization
  {$IFNDEF CLR}
  {$IFNDEF CLX}
  if TeeWinInetDLL<>0 then TeeFreeLibrary(TeeWinInetDLL);
  {$ENDIF}
  {$ENDIF}
  DestroyCachedStreams;
  Cached.Free;
end.