Компоненты к Delphi (каталог ссылок) 5

Status
Not open for further replies.

rezasadigh

Member
Joined
Sep 6, 2010
Messages
8
Reaction score
12
Age
52
Last edited by a moderator:

HmMik

Member
Joined
Nov 4, 2004
Messages
20
Reaction score
7
К сожалению, использованная ссылка недоступна
You need to log in to view the content.
 

tmcdos

Member
Joined
Apr 26, 2007
Messages
58
Reaction score
202
Location
Sofia
Small fixes for VirtualTree 4.8.5

On line 23580 (near the end of procedure HandleMouseDown - just before Drag'n'Drop initiation) add these:
Code:
  else
  begin
  	ClearSelection;
  	SetFocusedNode(NIL);
  end;
  // end of fix
this is needed to properly emulate TListView behaviour - clicking nowhere in the client area
deselects and removes focus rectangle.

---------------------------------------------------------------------------

On line 19095 (end of procedure WMRButtonUp) add ELSE clause to the IF:
PHP:
  if not Assigned(PopupMenu) then
    DoPopupMenu(HitInfo.HitNode, HitInfo.HitColumn, Point(Message.XPos, Message.YPos))
  Else
    Inherited; // fix by IVO GELOV
and comment-out the INHERITED keyword on line 19085 (because otherwise PopUp is shown before the selection is updated, which is wrong)

---------------------------------------------------------------------------

Commented-out all BF_MIDDLE occurencies, since with this flag DrawEdge uses system default color, instead of current Brush.

---------------------------------------------------------------------------

On line 23405 in procedure HandleMouseDown, add this:
PHP:
  if toSimpleDrawSelection in FOptions.FSelectionOptions then 
  	IsHit := false 
  else
  	IsHit := not AltPressed and ((hiOnItemLabel in HitInfo.HitPositions) or (hiOnNormalIcon in HitInfo.HitPositions));

---------------------------------------------------------------------------

On line 8873 replace

if FCaptionText = '' then FCaptionText := FText;

with
PHP:
	FCaptionText := WrapString(DC, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat);

on line 9120 in the end of procedure ComputeHeaderLayout, delete

R := TextBounds;

and replace "R" with "TextBounds" in the parameter list of the next 2 commmands.

this is needed, because otherwise if header column is coWrapCaption - it is painted as single line until the very first MouseLeave from any header column.

---------------------------------------------------------------------------

On line 8364 in AdjustColumnIndex

insert the following as the outer block:
PHP:
    // this fix is for the case when one form inherits from another form, 
    // but VirtualTree columns are different on both forms - in this case
    // TFiler CLEARS the column collection, and we come here
    H:=TVirtualTreeColumns(Collection).FHeader;
    if not (csLoading in H.Treeview.ComponentState) and not (hsLoading in H.FStates) then
    begin
      ......
    end;

Добавлено через 7 минут
frxBarcode.pas
PHP:
procedure TfrxBarCodeView.GetData;
begin
  inherited;
  if IsDataField then
    FText := VarToStr(DataSet.Value[DataField,Self]) // IVO GELOV - added Self
  else if FExpression <> '' then
    FText := VarToStr(Report.Calc(FExpression));
end;

frxChBox.pas
PHP:
procedure TfrxCheckBoxView.GetData;
var
  v: Variant;
begin
  inherited;
  if IsDataField then
  begin
    v := DataSet.Value[DataField,Self]; // IVO GELOV - added Self
    if v = Null then
      v := False;
    FChecked := v;
  end
  else if FExpression <> '' then
    FChecked := Report.Calc(FExpression);
end;

frxRich.pas
PHP:
procedure TfrxRichView.GetData;
........
    if DataSet.IsBlobField(DataField) then
    begin
      ss := TStringStream.Create('');
      DataSet.AssignBlobTo(DataField, ss)
    end
    else
      ss := TStringStream.Create(VarToStr(DataSet.Value[DataField,Self])); // IVO GELOV - added Self
    try
      FRichEdit.Lines.LoadFromStream(ss);
    finally
      ss.Free;
    end;
.......

frxEngine.pas
PHP:
procedure TfrxEngine.Stretch(Band: TfrxBand);
.........
        {if c is TfrxStretcheable then
          TfrxStretcheable(c).StretchMode := smDontStretch;} // IVO GELOV - bugfix
.........

frxClassRTTI.pas
PHP:
function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
..............
    else if MethodName = 'VALUE.GET' then
      Result := _TfrxDataSet.Value[Caller.Params[0],Instance] // IVO GELOV - added Instance
.........

frxDBSet.pas
PHP:
function TfrxDBDataset.GetValue(Index: String; Obj:TObject): Variant; // IVO GELOV - added Obj

frxCross.pas
PHP:
procedure TfrxDBCrossView.FillMatrix;
......
          RowValues[i] := DataSet.Value[FRowFields[i],Self] // IVO GELOV - added Self
.....
          ColumnValues[i] := DataSet.Value[FColumnFields[i],Self] // IVO GELOV - added Self
.........
          CellValues[i] := DataSet.Value[FCellFields[i],Self] // IVO GELOV - added Self

frxClass.pas
PHP:
  TfrxDataSet = class(TfrxDialogComponent)
  protected
    function GetValue(Index: String; Obj:TObject): Variant; virtual; // IVO GELOV - added Obj
  public
    property Value[Index: String; Obj:Tobject]: Variant read GetValue; // IVO GELOV - added Obj
  end;

  TfrxUserDataSet = class(TfrxDataset)
  protected
    function GetValue(Index: String; Obj:TObject): Variant; override;// IVO GELOV - added Obj
  end;

  TfrxReport = class(TfrxComponent)
  private
    function DoGetValue(Instance:TObject; const Expr: String; var Value: Variant): Boolean; // IVO GELOV - added Instance

function TfrxUserDataSet.GetValue(Index: String; Obj:TObject): Variant; // IVO GELOV - added Obj
begin
  Result := Null;
  if Assigned(FOnGetValue) then
    FOnGetValue(Index, Result);
  if Assigned(FOnNewGetValue) then
    FOnNewGetValue({Self}Obj, Index, Result); // IVO GELOV - Self is useless, Obj is the object which requests data
end;

procedure TfrxCustomMemoView.GetData;
........
    begin
      FValue := DataSet.Value[DataField,Self]; // IVO GELOV - added Self
      if FDisplayFormat.Kind = fkText then
      begin
        if LocCharset then
          FMemo.Text := AnsiToUnicode(AnsiString(DataSet.DisplayText[DataField]), Font.Charset) else
          FMemo.Text := DataSet.DisplayText[DataField];
      end
........
end;

function TfrxReport.Calc(const Expr: String; AScript: TfsScript = nil): Variant;
.........
  if not DoGetValue(NIL, Expr, Result) then // IVO GELOV - added NIL
.......
end;

function TfrxReport.DoGetValue(Instance:TObject; const Expr: String; var Value: Variant): Boolean; // IVO GELOV - added Instance
.............
  if (ds <> nil) and (fld <> '') then
  begin
    Value := ds.Value[fld,Instance]; // IVO GELOV - added Instance
...........
end;

function TfrxReport.GetScriptValue(Instance: TObject; ClassType: TClass;
  const MethodName: String; var Params: Variant): Variant;
var
  i: Integer;
  s: String;
begin
  if not DoGetValue(Instance, Params[0], Result) then // IVO GELOV - added Instance
..........
end;

The only real "bug" is in frxEngine - in original, the stretching of sub-reports is intentionally disabled. I needed this stretching, so I forcibly re-enabled it.
Other fix is just to provide a usable Sender value in the event TfrxUserDataset.OnNewGetValue(Sender: TObject; const VarName: string; var Value: Variant) - in original, Sender is equal to TfrxDataset.Self but this is useless, so I modified it to point to the real object (usually TfrxMemoView) requesting a Value.
 
Last edited by a moderator:

stronger

Member
Joined
Aug 19, 2005
Messages
113
Reaction score
223
TMS All in One 2011.03.31 Full source

TMS All Components for D6-XE
TMS Component pack
TMS Async32
TMS Instrumentation Workshop
TMS TAdvSpreadGrid
TMS CETools
TMS Skin Factory
TMS Diagram Studio
TMS Scripter Studio Pro
TMS Query Studio
TMS Plugin Framework
TMS Security System
TMS MailMerge
TMS FlexCel Studio for
TMS Unicode Component Pack
TMS Advanced Charts
TMS Workflow Studio
TMS GUIMotions


http://hotfile.com/dl/112721163/952a2b0/FlexCelVCL.7z.html
http://hotfile.com/dl/112721240/b5b217e/TMS_Advanced_Charts.7z.html
http://hotfile.com/dl/112721442/21fdfe4/TMS_Advanced_Spreadgrid.7z.html
http://hotfile.com/dl/112721454/2ed1312/TMS_Async32.7z.html
http://hotfile.com/dl/112721476/8df5059/TMS_CETools.7z.html
http://hotfile.com/dl/112721604/2140820/TMS_Component_Pack.7z.html
http://hotfile.com/dl/112722654/e25de5c/TMS_Diagram_Studio.7z.html
http://hotfile.com/dl/112722915/a5ded1f/TMS_GUIMotions.7z.html
http://hotfile.com/dl/112722942/916df6c/TMS_Instrumentation_Workshop.7z.html
http://hotfile.com/dl/112723035/558a691/TMS_Mail_Merge_Wizards.7z.html
http://hotfile.com/dl/112723042/8ec44ba/TMS_Plugin_Framework.7z.html
http://hotfile.com/dl/112723104/ebd868d/TMS_Query_Studio.7z.html
http://hotfile.com/dl/112723304/a411996/TMS_Scripter_Studio_Pro.7z.html
http://hotfile.com/dl/112723580/8f1dcde/TMS_Security_System.7z.html
http://hotfile.com/dl/112723630/86a3bb2/TMS_Skin_Factory.7z.html
http://hotfile.com/dl/112723642/17bac06/TMS_Unicode_Component_Pack.7z.html
http://hotfile.com/dl/112723681/e43b5ce/TMS_Workflow_Studio.7z.html

password: chriszion
Enjoy
 

_SERGEYX_

Member
Joined
Jul 9, 2008
Messages
223
Reaction score
983
Коллеги, а TMS Component pack из пакета выше "TMS All in One 2011.03.31 Full source" более новый, чем v6.0.2.0 ? Или это одно и то же?
 
Status
Not open for further replies.
Top