I copied the source LabeledEdit example with a TBoundLabel in components I'm writing to attach a convenient label to. They work fine but I'm getting issues loading the .dfm form (seemingly when my component is on another such as a CategoryPanel):
Class TBoundLabel not found
Test form:
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 518
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object CategoryPanelGroup1: TCategoryPanelGroup
Left = 0
Top = 70
Width = 635
Height = 448
VertScrollBar.Tracking = True
Align = alClient
HeaderFont.Charset = DEFAULT_CHARSET
HeaderFont.Color = clWindowText
HeaderFont.Height = -11
HeaderFont.Name = 'Tahoma'
HeaderFont.Style = []
TabOrder = 0
object CategoryPanel1: TCategoryPanel
Top = 0
Caption = 'CategoryPanel1'
TabOrder = 0
end
object CategoryPanel2: TCategoryPanel
Top = 200
Caption = 'CategoryPanel2'
TabOrder = 1
object SubLabel: TBoundLabel
Width = 78
Height = 13
Caption = 'LabelledCombo1'
end
object LabelledCombo1: TLabelledCombo
Left = 152
Top = 80
Width = 145
Height = 21
LabelRotulo.Width = 78
LabelRotulo.Height = 13
LabelRotulo.Caption = 'LabelledCombo1'
TabOrder = 0
end
end
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 635
Height = 41
Align = alTop
Caption = 'Panel1'
TabOrder = 1
end
object ToolBar1: TToolBar
Left = 0
Top = 41
Width = 635
Height = 29
Caption = 'ToolBar1'
TabOrder = 2
end
end
Source for the LabelledCombo:
unit LabelledComboU;
interface
uses
WinApi.Windows,
WinApi.Messages,
System.SysUtils,
System.Math,
System.UITypes,
System.StrUtils,
System.Classes,
System.Types,
VCL.Forms,
VCL.ExtCtrls,
VCL.Controls,
VCL.Consts,
VCL.Dialogs,
VCL.ImgList,
VCL.Samples.Spin,
VCL.StdCtrls,
VCL.GraphUtil,
VCL.Graphics,
VCL.THemes,
VCL.Styles;
type
TLabelledCombo = class(TCustomComboBox)
private
FLabel: TBoundLabel;
FLabelPosition: TLabelPosition;
FLabelSpacing: Integer;
procedure SetLabelPosition(const Value: TLabelPosition);
procedure SetLabelSpacing(const Value: integer);
protected
procedure SetParent(AParent: TWinControl); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetName(const Value: TComponentName); override;
procedure CMVisiblechanged(var Message: TMessage);
message CM_VISIBLECHANGED;
procedure CMEnabledchanged(var Message: TMessage);
message CM_ENABLEDCHANGED;
procedure CMBidimodechanged(var Message: TMessage);
message CM_BIDIMODECHANGED;
public
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
procedure SetupInternalLabel;
published
property LabelRotulo: TBoundLabel read FLabel;
property LabelPosition: TLabelPosition read FLabelPosition write SetLabelPosition default lpAbove;
property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing default 3;
property Align;
property AutoComplete default True;
property AutoCompleteDelay default 500;
property AutoDropDown default False;
property AutoCloseUp default False;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property Style; { Must be published before Items }
property Anchors;
property BiDiMode;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property ExtendedUI default False;
property Font;
property ImeMode;
property ImeName;
property ItemHeight;
property ItemIndex default -1;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Text;
property TextHint;
property Touch;
property Visible;
property StyleElements;
property StyleName;
property OnChange;
property OnClick;
property OnCloseUp;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGesture;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseEnter;
property OnMouseLeave;
property OnSelect;
property OnStartDock;
property OnStartDrag;
property Items; { Must be published after OnMeasureItem }
end;
implementation
{ TLabelledCombo }
procedure TLabelledCombo.CMBidimodechanged(var Message: TMessage);
begin
if FLabel <> nil then
FLabel.BiDiMode := BiDiMode;
end;
procedure TLabelledCombo.CMEnabledchanged(var Message: TMessage);
begin
inherited;
if FLabel <> nil then
FLabel.Enabled := Enabled;
end;
procedure TLabelledCombo.CMVisiblechanged(var Message: TMessage);
begin
inherited;
if FLabel <> nil then
FLabel.Visible := Visible;
end;
constructor TLabelledCombo.Create(AOwner: TComponent);
begin
inherited;
FLabelPosition := lpAbove;
FLabelSpacing := 3;
SetupInternalLabel;
end;
procedure TLabelledCombo.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FLabel) and (Operation = opRemove) then
FLabel := nil;
end;
procedure TLabelledCombo.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
SetLabelPosition(FLabelPosition);
end;
procedure TLabelledCombo.SetLabelPosition(const Value: TLabelPosition);
var
P: TPoint;
begin
if FLabel = nil then Exit;
FLabelPosition := Value;
case Value of
lpAbove:
P := Point(Left, Top - FLabel.Height - FLabelSpacing);
lpBelow:
P := Point(Left, Top + Height + FLabelSpacing);
lpLeft : P := Point(Left - FLabel.Width - FLabelSpacing,
Top + ((Height - FLabel.Height) div 2));
lpRight: P := Point(Left + Width + FLabelSpacing,
Top + ((Height - FLabel.Height) div 2));
end;
FLabel.SetBounds(P.x, P.y, FLabel.Width, FLabel.Height);
end;
procedure TLabelledCombo.SetLabelSpacing(const Value: integer);
begin
FLabelSpacing := Value;
SetLabelPosition(FLabelPosition);
end;
procedure TLabelledCombo.SetName(const Value: TComponentName);
var
LClearText: Boolean;
begin
if (csDesigning in ComponentState) and (FLabel <> nil) and
((Flabel.GetTextLen = 0) or
(CompareText(FLabel.Caption, Name) = 0)) then
FLabel.Caption := Value;
LClearText := (csDesigning in ComponentState) and (Text = '');
inherited SetName(Value);
if LClearText then
Text := '';
end;
procedure TLabelledCombo.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
if FLabel = nil then exit;
FLabel.Parent := AParent;
FLabel.Visible := True;
end;
procedure TLabelledCombo.SetupInternalLabel;
begin
if Assigned(FLabel) then exit;
FLabel := TBoundLabel.Create(Self);
FLabel.FreeNotification(Self);
// FLabel.FocusControl := Self;
end;
end.
This is the barest test which reproduces the problem, a LabelledCombo on a CategoryPanel. (On a form I am not getting grief.)
I tried deleting the reference to Sublabel and resaving the .DFM but it comes back again.
I can't see what to fix: the source is identical to that of TLabeledEdit except that TBoundLabel is not in my Unit. Do I need to copy the source of that too into my component unit?
Mike
The problem is that you are trying to re-use TBoundLabel - which has been designed specifically to be used from within TCustomLabeledEdit only. Using it elsewhere will lead to unwanted side effects. In the code below (taken from VCL.ExtCtrls.pas) you can easily see that TBoundLabel is basically bound to TCustomLabeledEdit.
If that is a smart design, is a different question though.
procedure TBoundLabel.AdjustBounds;
begin
inherited AdjustBounds;
if Owner is TCustomLabeledEdit then
with Owner as TCustomLabeledEdit do
SetLabelPosition(LabelPosition);
end;
There is a bug in Delphi Sydney, whereby a TLabeledEdit placed on a TCategoryPanel gives the fault I raised in my query.
How to experience it
Place a TCategoryPanelGroup on a form, create a couple of TCategoryPanels on it
Place an ordinary Panel on the form.
Place a TLabeledEdit on step 2's Panel.
View as Text then View as Form (Alt/F12)
there should be no problem.
Move the TLabeledEdit off the Panel and onto one of the TCategoryPanels.
Repeat step 4.
Try moving it onto another TPanel on one of the TCategoryPanels: again there is no problem.
No wonder I had trouble with my labelled components....
Related
I have Delphi 2006 client application. This client recieves an Olevariant type data from COM server. The function is:
procedure OnLimitsChanged(var SymbolsChanged: {??PSafeArray}OleVariant);
This function returns an array of string. I can´t read OleVariant type data from delphi.
From Excel VBA it´s working:
Private Sub g_Realtime_OnLimitsChanged(SymbolsChanged() As String)
Dim i%
Dim Salir As Boolean
If UBound(SymbolsChanged) <> -1 Then
i = 0: Salir = False
While Not Salir
If SymbolsChanged(i) = Simbolo Then
LlamarALimites
Salir = True
Else
i = i + 1
If i > UBound(SymbolsChanged) Then Salir = True
End If
Wend
End If
End Sub
I tried to convert OleVariant to Psafearray...
procedure TfmConfiguracion.RecibirNuevosTicks(ASender: TObject;
var ArrayTicks : Olevariant);
var
Data : pSafeArray;
i,iLow, iHigh : Integer;
value : wideString;
begin
Data:=PSafeArray(TVarData(ArrayTicks).VArray);
SafeArrayGetLBound(Data,1,iLow);
SafeArrayGetUBound(Data,1,iHigh);
for i:=iLow to iHigh do
begin
SafeArrayGetElement(Data,i,Value);
Showmessage(Value);
end;
But I recieve an except in this line:
SafeArrayGetLBound(Data,1,iLow);
Debugger Fault Notification
Project ... faulted with message: ' access violation at 0x751de18c: read of address 0xabababab'. Process Stopper. Use Step or Run to continue
Any advice and suggestions will be greatly appreciated.
The RTL has a VarArrayAsPSafeArray() function for extracting a PSafeArray correctly from an (Ole)Variant:
procedure TfmConfiguracion.RecibirNuevosTicks(ASender: TObject; var ArrayTicks : OleVariant);
var
Data : PVarArray; // RTL's version of PSafeArray
//...
begin
Data := VarArrayAsPSafeArray(ArrayTicks);
//...
end;
If the (Ole)Variant does not contain an array, an exception will be raised. Or you can use VarIsArray() to check it manually:
procedure TfmConfiguracion.RecibirNuevosTicks(ASender: TObject; var ArrayTicks : OleVariant);
var
Data : PVarArray;
//...
begin
if not VarIsArray(ArrayTicks) then Exit;
Data := VarArrayAsPSafeArray(ArrayTicks);
//...
end;
That being said, (Ole)Variant has build-in support for accessing PSafeArray element data, so you don't really need to resort to accessing PSafeArray directly (unless you want an extra performance boost, in which case you need to validate the PSafeArray yourself before you access its data):
procedure TfmConfiguracion.RecibirNuevosTicks(ASender: TObject; var ArrayTicks : Olevariant);
var
i : Integer;
value : String;
begin
if not VarIsArray(ArrayTicks) then Exit;
for i := VarArrayLowBound(ArrayTicks, 1) to VarArrayHighBound(ArrayTicks, 1) do
begin
Value := ArrayTicks[i];
ShowMessage(Value);
end;
The RTL has the function let access a Varant array as a SAFEARRAY:
function VarArrayAsPSafeArray(const V: Variant): PSafeArray;
I wanted to document how to do the reverse.
Variant is a structure
In Delphi a Variant is an opaque blob. But internally it is really the TVarData structure (aka the Windows VARIANT structure). A variant can hold different types of data. You indicate which type through the VType member. The value of the VType member tells you how to interpret the rest of the structure:
a 32-bit Integer (VT_I4)
Variant
VType: Word = VT_I4; //3
VInteger: Integer;
a IUnknown interface (VT_UNKNOWN)
Variant
VType: Word = VT_UNKNOWN; //13
VUnknown: Pointer; //actually IUnknown
an BSTR (aka WideString in Delphi)
Variant
VType: Word = VT_BSTR; //8
VOleStr: PWideChar;
In the case that the variant is a SAFEARRAY of 32-bit integers:
Variant
VType: Word = (VT_ARRAY or VT_I4);
VArray: PVarArray;
And then VArray points to a SAFEARRAY strucuture:
Variant
VType: Word = (VT_ARRAY or VT_I4);
VArray: PVarArray;
cDims: Word;
fFeatures: Word;
cbElements: LongWord;
cLocks: LongWord;
pvData: Pointer;
rgsabound: array[0..0] of TSafeArrayBound;
What if we start with a SAFEARRAY
There are times, particularly when interacting with COM or .NET that you:
have to supply a PSafeArray,
or are given a PSafeArray.
You can construct a SafeArray easily enough, if you use Delphi's functions to create a variant array. Delphi does the heavy lifting to creating the underlying SafeArray that your "variant array" actually is.
But we want to go the other way; we are given a PSafeArray, and we want to wrap it up inside a Delphi Variant variable, so that it handles all the ugliness and lifetime.
assemblies: PSafeArray;
assemblies := DefaultAppDomain.GetAssemblies;
How can we deal with this pointer to a SAFEARRAY?
function PSafeArrayToVariant(psa: PSafeArray): OleVariant;
begin
TVarData(v).VType = (VT_ARRAY or VT_xxxx);
TVarData(v).VArray := PVarArray(psa);
end;
except we need to know what the SafeArray contains; we need to fill in the VT_xxxx in the above code.
Fortunately, one of the members of the SAFEARRAY structure tells what VType the members of the array are:
fFeatures: Word;
FADF_BSTR: It is an array of BSTRs (VT_BSTR)
FADF_UNKNOWN: It is an array of IUnknown (VT_UNKNOWN)
FADF_DISPATCH: It is an array of IDispatch (VT_DISPATCH)
FADF_VARIANT: It is an array of Variants (VT_VARIANT)
FADF_HAVEVARTYPE: You can get the type using SafeArrayGetVartype
Final function
function SafeArrayGetVartype(psa: PSafeArray): TVarType; safecall; external 'OleAut32.dll';
function PSafeArrayToVariant(psa: PSafeArray): OleVariant;
var
features: Word;
vt: TVarType;
const
FADF_HAVEVARTYPE = $80;
begin
features := psa^.fFeatures;
if (features and FADF_UNKNOWN) = FADF_UNKNOWN then
vt := VT_UNKNOWN
else if (features and FADF_DISPATCH) = FADF_DISPATCH then
vt := VT_DISPATCH
else if (features and FADF_VARIANT) = FADF_VARIANT then
vt := VT_VARIANT
else if (features and FADF_BSTR) <> 0 then
vt := VT_BSTR
else if (features and FADF_HAVEVARTYPE) <> 0 then
vt := SafeArrayGetVartype(psa)
else
vt := VT_UI4; //assume 4 bytes of *something*
TVarData(Result).VType := VT_ARRAY or vt;
TVarData(Result).VArray := PVarArray(psa);
end;
I want to add the files in the selected folder to the memobox or in a stringlist and show the results. In both ways, i can add them but i can't show the files from the folder in the memo or from the stringlist in a ShowMessage-dialog.
function CountFilesInFolder(AFolder: String; AMask: String): Integer;
var
tmp1: TSearchRec;
ergebnis: Integer;
memo1: string;
list : TStringList;
begin
result := 0;
if (AFolder <> '') then
begin
if AFolder[length(AFolder)] <> '\' then AFolder := AFolder + '\';
ergebnis := FindFirst(AFolder + AMask, faArchive + faReadOnly + faHidden + faSysFile, tmp1);
while ergebnis = 0 do
begin
Inc(result);
ergebnis := FindNext(tmp1);
while ((tmp1.Name = '|*_tif.tif')) and (ergebnis <> 0) do
ergebnis := FindNext(tmp1);
end;
list.Add(tmp1.Name);
FindClose(tmp1);
end;
end;
thank you for your time and sorry for my bad english.
A low-level function like this should not directly add items to a memo. Instead pass a TStrings (an abstraction of a string list) into the function and fill it:
function CountFilesInFolder(AFolder: String; AMask: String; FileNames: TStrings): Integer;
begin
// do your file enumeration
// for each file call FileNames.Add(FileName);
end;
Since the Lines property of a memo is also of type TStrings you can use it directly like this:
CountFilesInFolder('D:\', '*.TXT', Memo1.Lines);
If you wanted to have the filenames in a string list, the usual pattern goes like this:
FileNames := TStringList.Create;
try
CountFilesInFolder('D:\', '*.TXT', FileNames);
finally
FileNames.Free;
end;
The important point is that the caller creates and destroys the TStringList passed into CountFilesInFolder - an important principle in Delphi.
I use cxGrid and I want import a excel file to cxgrid. I wrote this code a function.
But, its wrong, because cxGrid dont know RowCount and ColCount.
I would like know, what can I use, what is similar?
Help me!
Thank you!
function Xls_To_cxGrid(AGrid: TcxGrid; AXLSFile: string): Boolean;
const
xlCellTypeLastCell = $0000000B;
var
XLApp, Sheet: OLEVariant;
RangeMatrix: Variant;
x, y, k, r: Integer;
begin
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
XLApp.Visible := False;
XLApp.Workbooks.Open(AXLSFile);
Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
x := XLApp.ActiveCell.Row;
y := XLApp.ActiveCell.Column;
AGrid.RowCount := x;
AGrid.ColCount := y;
RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
k := 1;
repeat
for r := 1 to y do
AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
Inc(k, 1);
AGrid.RowCount := k + 1;
until k > x;
RangeMatrix := Unassigned;
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
Result := True;
end;
end;
end;
The cxGrid is just a container for ChartViews, TableViews, CardViews and BandedTableViews. Being a container, it does not know anything about rows and columns. Because you want to replace a StringGrid I suggest using a (non-DB) TableView.
To get a TableView...
...open the grid customization form (click on "Customize..." in the grid's "Structure Navigator" in the form designer).
Go to the "Views" tab and click "Add View...". Choose "Table" (not "DB Table"!).
On the "Structure" tab right-click on the cxGrid1Level1 symbol, choose "Select View" and the new TableView.
You can now go back to the "Views" tab and delete the DB TableView (cxGrid1DBTableView1).
(See also the DX help topic "Grid Levels" unter the heading "Specifying Associated Grid Views".)
Instead of "RowCount" you would then use YourView.DataController.RecordCount. "ColCount" would be YourView.ColumnCount. You can access cell values with YourView.DataController.Values[...]. To speed up the populating the view I'd surround it with
YourView.DataController.BeginUpdate;
try
YourView.DataController.RecordCount := x;
// ...
finally
YourView.DataController.EndUpdate;
end;
I'd like to be able to access sections of a short string as part of a record
Something like
TMyRecord = record
case Boolean of
True:
(
EntireString: String[20];
);
False
(
StringStart: String[8];
StringMiddle: String[4];
StringEnd: String[8];
);
end;
Is this possible or would I have to declare each char individually
TMyRecord = record
private
Chars: Array[1..20] of Char;
Function GetStringStart:String;
Procedure SetStringStart(Value: String);
public
Property StringStart: String read GetStringStart write SetStringStart; // Can I have properties on a record?
end;
Function GetStringStart: String;
begin
Result := Chars[1] + Char[2]....;
end;
Procedure SetStringStart(Value: String);
begin
for i := 1 to 8 do
begin
Chars[i] := Value[i];
end;
end;
Is this possible / worth the effort?
A Delphi short string contains more than just the string contents. The initial byte in the data structure contains the length of the string. This is why short strings are limited to 255 characters.
So, you can't use short strings in your variant array the way you propose.
What you could do is adapt your second approach based on getter and setter methods to be a bit more readable.
For example:
function TMyRecord.GetStringStart: string;
begin
SetString(Result, #Chars[1], 8);
end;
You might consider using a string rather than a char array, but it's a little hard to be 100% sure of that advice without knowing exactly what your underlying problem is.
As a final thought, why not turn the problem around? Store 3 strings: StartString, MiddleString and EndString. Then have a property backed with a getter and setter called EntireString. When you read EntireString it pieces it together from the 3 individual parts, and when you write to it it pulls the individual parts out. I suspect it would be easier that way around.
Your first sample doesn't consider the length byte. The memory layout looks like this:
case True:
L12345678901234567890
^....................
case False:
L12345678L1234L12345678
^........^....^........
(L = length byte).
Depending on your requirements (e.g.: Are the partial strings always 8, 4 and 8 Chars?) I'd try storing the partial strings and make EntireString the property, using System.Copy, StrUtils.LeftStr etc.
ShortString has an implied length, so your first example will map the length parts of the substrings on top of the main string.
Your second sample is the way to start, with these notes:
properties on records are possible
you should think of the length of each sub-string (or is it always a fixed array of 20 characters?)
Edit
It totally depend on the reason you want this, and mixing character arrays and strings will get you into trouble because strings can be shorter than the array length.
Small example:
program VariantRecordsWithCharactersAndStrings;
{$APPTYPE CONSOLE}
uses
SysUtils,
Math;
const
Size20 = 20;
Size8 = 8;
Size4 = 4;
type
TChar20 = array[0..Size20-1] of Char;
TChar8 = array[0..Size8-1] of Char;
TChar4 = array[0..Size4-1] of Char;
TMyRecord = record
class var FillCharValue: Byte;
function GetEntireString: string;
function GetStringStart: string;
function GetStringMiddle: string;
function GetStringEnd: string;
procedure SetEntireString(const Value: string);
procedure SetStringStart(const Value: string);
procedure SetStringMiddle(const Value: string);
procedure SetStringEnd(const Value: string);
property EntireString: string read GetEntireString write SetEntireString;
property StringStart: string read GetStringStart write SetStringStart;
property StringMiddle: string read GetStringMiddle write SetStringMiddle;
property StringEnd: string read GetStringEnd write SetStringEnd;
procedure SetCharArray(const CharArrayPointer: PChar; const CharArraySize: Integer; const Value: string);
case Boolean of
True:
(
CharFull: TChar20;
);
False:
(
CharStart: TChar8;
CharMiddle: TChar4;
CharEnd: TChar8;
);
end;
function TMyRecord.GetEntireString: string;
begin
Result := CharFull;
end;
function TMyRecord.GetStringStart: string;
begin
Result := CharStart;
end;
function TMyRecord.GetStringMiddle: string;
begin
Result := CharMiddle;
end;
function TMyRecord.GetStringEnd: string;
begin
Result := CharEnd;
end;
procedure TMyRecord.SetEntireString(const Value: string);
begin
SetCharArray(CharFull, SizeOf(CharFull), Value);
end;
procedure TMyRecord.SetCharArray(const CharArrayPointer: PChar; const CharArraySize: Integer; const Value: string);
begin
FillChar(CharArrayPointer^, CharArraySize, FillCharValue);
Move(Value[1], CharArrayPointer^, Min(CharArraySize, SizeOf(Char)*Length(Value)));
end;
procedure TMyRecord.SetStringStart(const Value: string);
begin
SetCharArray(CharStart, SizeOf(CharStart), Value);
end;
procedure TMyRecord.SetStringMiddle(const Value: string);
begin
SetCharArray(CharMiddle, SizeOf(CharMiddle), Value);
end;
procedure TMyRecord.SetStringEnd(const Value: string);
begin
SetCharArray(CharEnd, SizeOf(CharEnd), Value);
end;
var
MyRecord: TMyRecord;
procedure Dump();
begin
Writeln(MyRecord.EntireString);
Writeln(MyRecord.StringStart);
Writeln(MyRecord.StringMiddle);
Writeln(MyRecord.StringEnd);
end;
procedure TestWithFillCharValue(const FillCharValue: Byte);
begin
Writeln('Testing with FillCharValue ', FillCharValue);
TMyRecord.FillCharValue := FillCharValue;
MyRecord.EntireString := '123456789001234567890';
Dump();
MyRecord.StringStart := 'AAA';
MyRecord.StringMiddle := 'BBB';
MyRecord.StringEnd := 'CCC';
Dump();
end;
begin
try
TestWithFillCharValue(0); // this will truncated all the sub arrays when you pass strings that are too short
TestWithFillCharValue(20); // when using Unicode, this fails even more horribly
Write('Press <Enter>');
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
This class does more or less what you want:
it has overlapping data structures
when you assign the arrays: no problem
when you assign the strings: be aware when strings get to short
As other stated, it won't work, because the variant-sized record will add some lengths for StringStart/StringMiddle/StringEnd in the middle of the EntireString type.
You are confusing the *char type of C with the pascal shortstring type. There is an hidden character at position [0] which is the shortstring length.
You could use regular string type, then split in on purpose:
procedure StringSplit(const EntireString: string; out StringStart, StringMiddle, StringEnd: string);
begin
if length(EntireString)<>20 then
exit;
StringStart := copy(EntireString,1,8);
StringMiddle := copy(EntireString,9,4);
StringEnd := copy(EntireString,13,8);
end;
Note that the out parameter type will set all output String* variables into '' before calling the function.
This version will expect entering entire string of 20 chars long.
You could use shortstrings, but with custom types of the exact length, if you want to avoid hidden copies from/to string[255] (which occur when you use a shortstring type and work with string[n] with n<255):
type
String20 = string[20];
String4 = string[4];
String8 = string[8];
procedure StringSplit(const EntireString: String20; out StringStart: String8;
out StringMiddle: String4; out StringEnd: String8);
begin
if length(EntireString)<>20 then
exit;
StringStart := copy(EntireString,1,8);
StringMiddle := copy(EntireString,9,4);
StringEnd := copy(EntireString,13,8);
end;
We got OPC job. I cannot installed RsLinx to my Win7 (and XP mode too) because of errors, so I send my test app to the real place, and somebody testing it.
Because I don't have DLL, I cannot make Delphi interface, so I need to do OLE Calls only.
I got an interesting problem with Group Add.
I demonstrate it:
procedure TForm1.Button8Click(Sender: TObject);
var
r, g : variant;
s : string;
v : variant;
ws : WideString;
begin
Log('Connect');
r := CreateOleObject('RSI.OPCAutomation');
r.Connect('RSLinx OPC Server');
Log('Add as constant');
g := r.OPCGroups.Add('MONKEY_C');
Log('Name ' + g.Name);
Log('Add as string');
s := 'MONKEY_S';
g := r.OPCGroups.Add(s);
Log('Name ' + g.Name);
Log('Add as variant');
s := 'MONKEY_V';
v := s;
g := r.OPCGroups.Add(v);
Log('Name ' + g.Name);
Log('Add as ole variant');
s := 'MONKEY_OV';
v := VarAsType(s, varOleStr);
g := r.OPCGroups.Add(v);
Log('Name ' + g.Name);
Log('Add as widestring');
s := 'MONKEY_WS';
ws := WideString(s);
g := r.OPCGroups.Add(ws);
Log('Name ' + g.Name);
Log('Add as widestring var');
s := 'MONKEY_WSV';
ws := WideString(s);
v := ws;
g := r.OPCGroups.Add(v);
Log('Name ' + g.Name);
r := 0;
end;
The result was:
Connect
Add as constant
Name MONKEY_C
Add as string
Name _Group0
Add as variant
Name _Group1
Add as ole variant
Name _Group2
Add as widestring
Name _Group3
Add as widestring var
Name _Group4
So the problem that I cannot add any Group than constant defined...
I need to know HOW Delphi compile this constant to I can convert my variant value to this format.
Can anybody help me in this theme?
Thanks:
dd
Hi!
So the problem is mysterious.
I found another errors in the pure OLE calls.
function TDDRsOPCObject.IndexOfGroup(GroupName: string): integer;
var
ogs, g : variant;
i : integer;
s : string;
begin
CheckObject;
Result := -1;
ogs := FObj.OPCGroups;
s := '';
for i := 1 to ogs.Count do begin
g := ogs.Item(i); // This is working
if AnsiCompareText(g.Name, GroupName) = 0 then begin
Result := i;
Exit;
end;
end;
end;
function TDDRsOPCObject.GetGroupByName(GroupName: string): variant;
var
idx : integer;
ogs, g : variant;
begin
CheckObject;
VarClear(Result);
idx := IndexOfGroup(GroupName);
ogs := FObj.OPCGroups;
if idx <> -1
then begin
g := ogs.Item(idx); // HERE I GOT: The parameter is incorrect
Result := g;
end;
end;
So it is interesting: the IndexOfGroup with same call is working, the GetGroupByName is not... :-(
So I determined I do not continue my fighting with windmills (Don Q).
I got TLB from a dear user that have Delphi7 (in Win7 the Delphi6 cannot produce OLE interface), and I found Kassl.
May these interfaces can help me...
Thanks:
dd
As far as I know the constant and the strings are all converted to an OleString/BSTR (WideString). But since you are having these problems... probably not.
What does the documentation of OPCGroups.Add say? What is expected?
Do you have a type library? Maybe you can import them and use the interface directly.
Edit:
The documentation isn't very clear.
There are a few things you can try:
Check in CPU view what the Delphi compiler made of the code with the constant, maybe you see some hints there about what to do with your strings.
Try this code.
code:
const
OPC_GROUP_NAME: WideString = 'MONKEY_C';
<...>
g := r.OPCGroups.Add(OPC_GROUP_NAME);
Log('Name ' + g.Name);
When above code works, try this:
const
{$J+} //writable constants on
OPC_GROUP_NAME: WideString = 'dummy';
{$J-}
<...>
OPC_GROUP_NAME := 'MONKEY_BLA';
g := r.OPCGroups.Add(OPC_GROUP_NAME);
Log('Name ' + g.Name); //should be: 'Name MONKEY_BLA'
Note: I don't like step 2, but if it works.. why not. To me it seems like there is a bug in the com-library you use.
Edit2:
I looked at the code generated by using the constant and using a normal string. With the constant I see the address of the first character being pushed on the stack, with the string I see the address of a pointer to a string being pushed on the stack.
With the code below I can simulate the same behaviour as with the constant:
var
lWideArray: array[0..40] of WideChar;
s: string;
i: Integer;
<..>
s := 'MONKEY_FOO';
for i := 0 to Length(lWideArray) - 1 do
begin
if i < Length(s) then
lWideArray[i] := WideChar(s[i+1])
else
lWideArray[i] := #0;
end;
g := r.OPCGroups.Add(WideString(lWideArray));
Log('Name ' + g.Name);
There are some issues in your code, also it would be nice to know which version of Delphi you're using, and what parameter type the Add() call use. Anyway some hints:
ws := WideString(s);
That's a wrong typecast. It won't convert your string to a WideString, it will just force the memory to be interpreted as such. Use
ws := s;
The compile will take care to call the conversion routine.
You do not have to invent the wheel. There are a lot of libraries, examples and sample code how to use OPC with Delphi. For free Delphi OPC servers and clients, take a look here: http://www.opcconnect.com/delphi.php.