pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

rx: Add Lazarus rx components to folder rx_laz, package rx.lpk (will be removed from lazarus/components)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6058 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-11-04 14:07:30 +00:00
parent df444a83b6
commit 4688f560e6
11 changed files with 3589 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
components/rx/trunk/rx.lpk Normal file
View File

@ -0,0 +1,59 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<Name Value="rx"/>
<Type Value="RunAndDesignTime"/>
<AddToProjectUsesSection Value="True"/>
<Author Value="Michael Van Canneyt, AO ROSNO, Master-Bank"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<OtherUnitFiles Value="rx_laz"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
</CompilerOptions>
<Description Value="Delphi VCL Extensions (RX)"/>
<Version Major="1"/>
<Files Count="4">
<Item1>
<Filename Value="rx_laz/apputils.pp"/>
<UnitName Value="AppUtils"/>
</Item1>
<Item2>
<Filename Value="rx_laz/mrulist.pp"/>
<HasRegisterProc Value="True"/>
<UnitName Value="MRUList"/>
</Item2>
<Item3>
<Filename Value="rx_laz/placement.pp"/>
<UnitName Value="Placement"/>
</Item3>
<Item4>
<Filename Value="rx_laz/strholder.pp"/>
<HasRegisterProc Value="True"/>
<UnitName Value="StrHolder"/>
</Item4>
</Files>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

23
components/rx/trunk/rx.pas Normal file
View File

@ -0,0 +1,23 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit rx;
{$warn 5023 off : no warning about unused units}
interface
uses
AppUtils, MRUList, Placement, StrHolder, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('MRUList', @MRUList.Register);
RegisterUnit('StrHolder', @StrHolder.Register);
end;
initialization
RegisterPackage('rx', @Register);
end.

447
components/rx/trunk/rx_laz/apputils.pp Normal file
View File

@ -0,0 +1,447 @@
{*******************************************************}
{ }
{ Delphi VCL Extensions (RX) }
{ }
{ Copyright (c) 1995, 1996 AO ROSNO }
{ Copyright (c) 1997, 1998 Master-Bank }
{ }
{*******************************************************}
{$mode objfpc}
{$h+}
unit AppUtils;
interface
uses
Classes, Controls, Forms, LazFileUtils, LazUTF8, IniFiles, Grids;
function GetDefaultSection(Component: TComponent): string;
procedure GetDefaultIniData(Control: TControl; var IniFileName, Section: string );
function GetDefaultIniName: string;
type
TOnGetDefaultIniName = function: string;
const
OnGetDefaultIniName: TOnGetDefaultIniName = nil;
var
DefCompanyName: string = '';
RegUseAppTitle: Boolean = False;
function FindForm(FormClass: TFormClass): TForm;
function FindShowForm(FormClass: TFormClass; const Caption: string): TForm;
function ShowDialog(FormClass: TFormClass): Boolean;
function InstantiateForm(FormClass: TFormClass; var Reference): TForm;
procedure SaveFormPlacement(Form: TForm; const IniFileName: string);
procedure RestoreFormPlacement(Form: TForm; const IniFileName: string);
procedure WriteFormPlacement(Form: TForm; IniFile: TCustomIniFile; const Section: string);
procedure ReadFormPlacement(Form: TForm; IniFile: TCustomIniFile; const Section: string; LoadState, LoadPosition: Boolean);
procedure SaveMDIChildren(MainForm: TForm; IniFile: TCustomIniFile);
procedure RestoreMDIChildren(MainForm: TForm; IniFile: TCustomIniFile);
procedure RestoreGridLayout(Grid: TCustomGrid; IniFile: TCustomIniFile; Const Section : String);
procedure SaveGridLayout(Grid: TCustomGrid; IniFile: TCustomIniFile; Const Section : string);
function GetUniqueFileNameInDir(const Path, FileNameMask: string): string;
function StrToIniStr(const Str: string): string;
function IniStrToStr(const Str: string): string;
{ Internal using utilities }
implementation
uses
SysUtils, Placement, LCLStrConsts;
{ Copied. Need to be moved somewhere in the RTL, actually }
Type
TCharset = Set of Char;
function WordPosition(const N: Integer; const S: string; const WordDelims: TCharSet): Integer;
var
Count, I: Integer;
begin
Count := 0;
I := 1;
Result := 0;
while (I <= Length(S)) and (Count <> N) do
begin
while (I <= Length(S)) and (S[I] in WordDelims) do
Inc(I);
if I <= Length(S) then
Inc(Count);
if Count <> N then
while (I <= Length(S)) and not (S[I] in WordDelims) do
Inc(I)
else
Result := I;
end;
end;
function ExtractWord(N: Integer; const S: string; const WordDelims: TCharSet): string;
var
I: Integer;
Len: Integer;
begin
Len := 0;
I := WordPosition(N, S, WordDelims);
if I <> 0 then
{ find the end of the current word }
while (I <= Length(S)) and not(S[I] in WordDelims) do begin
{ add the I'th character to result }
Inc(Len);
SetLength(Result, Len);
Result[Len] := S[I];
Inc(I);
end;
SetLength(Result, Len);
end;
function GetDefaultSection(Component: TComponent): string;
var
F: TCustomForm;
Owner: TComponent;
begin
if Component <> nil then begin
if Component is TCustomForm then Result := Component.ClassName
else begin
Result := Component.Name;
if Component is TControl then begin
F := GetParentForm(TControl(Component));
if F <> nil then Result := F.ClassName + Result
else begin
if TControl(Component).Parent <> nil then
Result := TControl(Component).Parent.Name + Result;
end;
end
else begin
Owner := Component.Owner;
if Owner is TForm then
Result := Format('%s.%s', [Owner.ClassName, Result]);
end;
end;
end
else Result := '';
end;
function GetDefaultIniName: string;
begin
if Assigned(OnGetDefaultIniName) then
Result:= OnGetDefaultIniName()
else
Result := ExtractFileName(ChangeFileExt(Application.ExeName, '.INI'));
end;
procedure GetDefaultIniData(Control: TControl; var IniFileName, Section: string);
var
I: Integer;
begin
IniFileName := EmptyStr;
with Control do
if Owner is TCustomForm then
for I := 0 to Owner.ComponentCount - 1 do
if (Owner.Components[I] is TFormPlacement) then begin
IniFileName := TFormPlacement(Owner.Components[I]).IniFileName;
Break;
end;
Section := GetDefaultSection(Control);
if IniFileName = EmptyStr then
IniFileName := GetDefaultIniName;
end;
function FindForm(FormClass: TFormClass): TForm;
var
I: Integer;
begin
Result := nil;
for I := 0 to Screen.FormCount - 1 do begin
if Screen.Forms[I] is FormClass then begin
Result := Screen.Forms[I];
Break;
end;
end;
end;
function InternalFindShowForm(FormClass: TFormClass;
const Caption: string; Restore: Boolean): TForm;
var
I: Integer;
begin
Result := nil;
for I := 0 to Screen.FormCount - 1 do begin
if Screen.Forms[I] is FormClass then
if (Caption = '') or (Caption = Screen.Forms[I].Caption) then begin
Result := Screen.Forms[I];
Break;
end;
end;
if Result = nil then begin
Application.CreateForm(FormClass, Result);
if Caption <> '' then Result.Caption := Caption;
end;
with Result do begin
if Restore and (WindowState = wsMinimized) then WindowState := wsNormal;
Show;
end;
end;
function FindShowForm(FormClass: TFormClass; const Caption: string): TForm;
begin
Result := InternalFindShowForm(FormClass, Caption, True);
end;
function ShowDialog(FormClass: TFormClass): Boolean;
var
Dlg: TForm;
begin
Application.CreateForm(FormClass, Dlg);
try
Result := byte(Dlg.ShowModal) in [mrOk, mrYes];
finally
Dlg.Free;
end;
end;
function InstantiateForm(FormClass: TFormClass; var Reference): TForm;
begin
if TForm(Reference) = nil then
Application.CreateForm(FormClass, Reference);
Result := TForm(Reference);
end;
function StrToIniStr(const Str: string): string;
begin
Result:=StringReplace(Str,LineEnding,'\n',[rfReplaceAll]);
end;
function IniStrToStr(const Str: string): string;
begin
Result:=StringReplace(Str,'\n',LineEnding,[rfReplaceAll]);
end;
const
{ The following strings should not be localized }
siFlags = 'Flags';
//siShowCmd = 'ShowCmd';
//siMinMaxPos = 'MinMaxPos';
siNormPos = 'NormPos';
siPixels = 'PixelsPerInch';
siMDIChild = 'MDI Children';
siListCount = 'Count';
siItem = 'Item%d';
procedure SaveMDIChildren(MainForm: TForm; IniFile: TCustomIniFile);
{$ifdef nevertrue}
var
I: Integer;
{$endif}
begin
if (MainForm = nil) or (MainForm.FormStyle <> fsMDIForm) then
raise EInvalidOperation.Create(SNoMDIForm);
IniFile.EraseSection( siMDIChild);
//!! MVC: Needs fixing !
{$ifdef nevertrue}
if MainForm.MDIChildCount > 0 then begin
IniWriteInteger(IniFile, siMDIChild, siListCount,
MainForm.MDIChildCount);
for I := 0 to MainForm.MDIChildCount - 1 do
IniWriteString(IniFile, siMDIChild, Format(siItem, [I]),
MainForm.MDIChildren[I].ClassName);
end;
{$endif}
end;
procedure RestoreMDIChildren(MainForm: TForm; IniFile: TCustomIniFile);
var
I: Integer;
Count: Integer;
FormClass: TFormClass;
begin
if (MainForm = nil) or (MainForm.FormStyle <> fsMDIForm) then
raise EInvalidOperation.Create(SNoMDIForm);
Count := IniFile.ReadInteger(siMDIChild, siListCount, 0);
if Count > 0 then begin
for I := 0 to Count - 1 do begin
FormClass := TFormClass(GetClass(Inifile.ReadString(siMDIChild,
Format(siItem, [Count - I - 1]), '')));
if FormClass <> nil then
InternalFindShowForm(FormClass, '', False);
end;
end;
end;
procedure SaveGridLayout(Grid: TCustomGrid; IniFile: TCustomIniFile;
const Section: string);
var
I: Longint;
begin
for I := 0 to TDrawGrid(Grid).ColCount - 1 do
Inifile.WriteInteger(Section, Format(siItem, [I]),TDrawGrid(Grid).ColWidths[I]);
end;
procedure RestoreGridLayout(Grid: TCustomGrid; IniFile: TCustomIniFile;
const Section: string);
var
I: Longint;
begin
for I := 0 to TDrawGrid(Grid).ColCount - 1 do
TDrawGrid(Grid).ColWidths[I] := IniFile.ReadInteger(Section,
Format(siItem, [I]), TDrawGrid(Grid).ColWidths[I]);
end;
function CrtResString: string;
begin
//!! bogus function
Result := Format('(%dx%d)', [1200,1024]);
end;
function ReadPosStr(IniFile: TCustomInifile; const Section, Ident: string): string;
begin
Result := IniFile.ReadString(Section, Ident + CrtResString, '');
if Result = '' then
Result := IniFile.ReadString(Section, Ident, '');
end;
procedure WritePosStr(IniFile: TCustomInifile; const Section, Ident, Value: string);
begin
IniFile.WriteString(Section, Ident + CrtResString, Value);
IniFile.WriteString(Section, Ident, Value);
end;
procedure WriteFormPlacement(Form: TForm; IniFile: TCustomInifile; const Section: string);
begin
with Form do
begin
IniFile.WriteInteger(Section, siFlags, Ord(WindowState));
IniFile.WriteInteger(Section, siPixels, Screen.PixelsPerInch);
WritePosStr(IniFile, Section, siNormPos, Format('%d,%d,%d,%d',[Left, Top, Width,Height]));
end;
end;
procedure SaveFormPlacement(Form: TForm; const IniFileName: string);
var
IniFile: TInifile;
begin
IniFile := TIniFile.Create(UTF8ToSys(IniFileName));
try
WriteFormPlacement(Form, IniFile, Form.ClassName);
finally
IniFile.Free;
end;
end;
type
{$IFNDEF LCL}
//!! MVC: dirty VCL/CLX hack, not needed in Lazarus
TNastyForm = class(TScrollingWinControl)
private
FActiveControl: TWinControl;
FFocusedControl: TWinControl;
// FBorderIcons: TBorderIcons;
FBorderStyle: TFormBorderStyle;
FWindowState: TWindowState; { !! }
end;
{$ENDIF}
THackComponent = class(TComponent)
end;
procedure ReadFormPlacement(Form: TForm; IniFile: TCustomIniFile;
const Section: string; LoadState, LoadPosition: Boolean);
const
Delims = [',',' '];
var
PosStr: string;
PI,L,T,H,W : Integer;
begin
//Writeln('ReadFormPlaceMent');
if not (LoadState or LoadPosition) then
Exit;
PI:=IniFile.ReadInteger(Section, siPixels,Screen.PixelsPerInch);
if LoadPosition and (Screen.PixelsPerInch=PI) then
with Form do
begin
//Writeln('Loading position');
PosStr:=ReadPosStr(IniFile, Section, siNormPos);
if PosStr <> '' then
begin
//Writeln('Have position');
L := StrToIntDef(ExtractWord(1, PosStr, Delims), Left);
T := StrToIntDef(ExtractWord(2, PosStr, Delims), Top);
W := StrToIntDef(ExtractWord(3, PosStr, Delims), Width);
H := StrToIntDef(ExtractWord(4, PosStr, Delims), Height);
If not (BorderStyle in [bsSizeable , bsSizeToolWin ]) then
begin
if (Position in [poScreenCenter , poDesktopCenter ]) and
not (csDesigning in ComponentState) then
begin
THackComponent(Form).SetDesigning(True);
try
Position := poDesigned;
finally
THackComponent(Form).SetDesigning(False);
end;
end;
end;
//Writeln('Set bounds');
SetBounds(L,T,W,H);
end;
end;
if LoadState then
With Form do
begin
//Writeln('Loading state');
PI := IniFile.ReadInteger(Section, siFlags,Ord( WindowState));
If (Ord(Low(TWindowState))<=PI) and (PI<=Ord(High(TWindowState))) then
WindowState:=TWindowState(PI);
end;
end;
procedure RestoreFormPlacement(Form: TForm; const IniFileName: string);
var
IniFile: TIniFile;
begin
IniFile := TIniFile.Create(UTF8ToSys(IniFileName));
try
ReadFormPlacement(Form, IniFile, Form.ClassName, True, True);
finally
IniFile.Free;
end;
end;
function GetUniqueFileNameInDir(const Path, FileNameMask: string): string;
var
CurrentName: string;
I: Integer;
begin
Result := '';
for I := 0 to MaxInt do begin
CurrentName := Format(FileNameMask, [I]);
if not FileExistsUTF8(IncludeTrailingPathDelimiter(Path) + CurrentName) then
begin
Result := CurrentName;
Exit;
end;
end;
end;
end.

2
components/rx/trunk/rx_laz/lib/README.txt Normal file
View File

@ -0,0 +1,2 @@
Output directory for the rx package.

614
components/rx/trunk/rx_laz/mrulist.pp Normal file
View File

@ -0,0 +1,614 @@
{*******************************************************}
{ }
{ Delphi VCL Extensions (RX) }
{ }
{ Copyright (c) 1997, 1998 Master-Bank }
{ }
{*******************************************************}
{$mode objfpc}
{$h+}
unit MRUList;
interface
uses SysUtils, Classes, LResources, Menus, IniFiles, Placement;
type
TRecentStrings = class;
{ TMRUManager }
TGetItemEvent = procedure (Sender: TObject; var ACaption: string;
var ShortCut: TShortCut; UserData: Longint) of object;
TReadItemEvent = procedure (Sender: TObject; IniFile: TCustomInifile;
const Section: string; Index: Integer; var RecentName: string;
var UserData: Longint) of object;
TWriteItemEvent = procedure (Sender: TObject; IniFile: TCustomIniFile;
const Section: string; Index: Integer; const RecentName: string;
UserData: Longint) of object;
TClickMenuEvent = procedure (Sender: TObject; const RecentName,
ACaption: string; UserData: PtrInt) of object;
TAccelDelimiter = (adTab, adSpace);
TRecentMode = (rmInsert, rmAppend);
TMRUManager = class(TComponent)
private
FList: TStrings;
FItems: TList;
FIniLink: TIniLink;
FSeparateSize: Word;
FAutoEnable: Boolean;
FAutoUpdate: Boolean;
FShowAccelChar: Boolean;
FRemoveOnSelect: Boolean;
FStartAccel: Cardinal;
FAccelDelimiter: TAccelDelimiter;
FRecentMenu: TMenuItem;
FOnChange: TNotifyEvent;
FOnGetItem: TGetItemEvent;
FOnClick: TClickMenuEvent;
FOnReadItem: TReadItemEvent;
FOnWriteItem: TWriteItemEvent;
procedure ListChanged(Sender: TObject);
procedure ClearRecentMenu;
procedure SetRecentMenu(Value: TMenuItem);
procedure SetSeparateSize(Value: Word);
function GetStorage: TFormPlacement;
procedure SetStorage(Value: TFormPlacement);
function GetCapacity: Integer;
procedure SetCapacity(Value: Integer);
function GetMode: TRecentMode;
procedure SetMode(Value: TRecentMode);
procedure SetStartAccel(Value: Cardinal);
procedure SetShowAccelChar(Value: Boolean);
procedure SetAccelDelimiter(Value: TAccelDelimiter);
procedure SetAutoEnable(Value: Boolean);
procedure AddMenuItem(Item: TMenuItem);
procedure MenuItemClick(Sender: TObject);
procedure IniSave(Sender: TObject);
procedure IniLoad(Sender: TObject);
procedure InternalLoad(Ini: TCustomInifile; const Section: string);
procedure InternalSave(Ini: TCustomIniFile; const Section: string);
protected
procedure Change; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure DoReadItem(Ini: TCustomIniFile; const Section: string;
Index: Integer; var RecentName: string; var UserData: Longint); dynamic;
procedure DoWriteItem(Ini: TCustomIniFile; const Section: string; Index: Integer;
const RecentName: string; UserData: Longint); dynamic;
procedure GetItemData(var Caption: string; var ShortCut: TShortCut;
UserData: Longint); dynamic;
procedure DoClick(const RecentName, Caption: string; UserData: PtrInt); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Add(const RecentName: string; UserData: Longint);
procedure Clear;
procedure Remove(const RecentName: string);
procedure UpdateRecentMenu;
procedure LoadFromIni(Ini: TCustomIniFile; const Section: string);
procedure SaveToIni(Ini: TCustomIniFile; const Section: string);
property Strings: TStrings read FList;
published
property AccelDelimiter: TAccelDelimiter read FAccelDelimiter write SetAccelDelimiter default adTab;
property AutoEnable: Boolean read FAutoEnable write SetAutoEnable default True;
property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate default True;
property Capacity: Integer read GetCapacity write SetCapacity default 10;
property Mode: TRecentMode read GetMode write SetMode default rmInsert;
property RemoveOnSelect: Boolean read FRemoveOnSelect write FRemoveOnSelect default False;
property IniStorage: TFormPlacement read GetStorage write SetStorage;
property SeparateSize: Word read FSeparateSize write SetSeparateSize default 0;
property RecentMenu: TMenuItem read FRecentMenu write SetRecentMenu;
property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
property StartAccel: Cardinal read FStartAccel write SetStartAccel default 1;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnClick: TClickMenuEvent read FOnClick write FOnClick;
property OnGetItemData: TGetItemEvent read FOnGetItem write FOnGetItem;
property OnReadItem: TReadItemEvent read FOnReadItem write FOnReadItem;
property OnWriteItem: TWriteItemEvent read FOnWriteItem write FOnWriteItem;
end;
{ TRecentStrings }
TRecentStrings = class(TStringList)
private
FMaxSize: Integer;
FMode: TRecentMode;
procedure SetMaxSize(Value: Integer);
public
constructor Create;
function Add(const S: string): Integer; override;
procedure AddStrings(NewStrings: TStrings); override;
procedure DeleteExceed;
procedure Remove(const S: String);
property MaxSize: Integer read FMaxSize write SetMaxSize;
property Mode: TRecentMode read FMode write FMode;
end;
Procedure Register;
implementation
{$R mrulist.res}
uses Controls, AppUtils;
const
siRecentItem = 'Item_%d';
siRecentData = 'User_%d';
Procedure Register;
begin
RegisterComponents('Misc',[TMRUManager]);
end;
{ TMRUManager }
constructor TMRUManager.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FList := TRecentStrings.Create;
FItems := TList.Create;
TRecentStrings(FList).OnChange := @ListChanged;
FIniLink := TIniLink.Create;
FIniLink.OnSave := @IniSave;
FIniLink.OnLoad := @IniLoad;
FAutoUpdate := True;
FAutoEnable := True;
FShowAccelChar := True;
FStartAccel := 1;
end;
destructor TMRUManager.Destroy;
begin
ClearRecentMenu;
FIniLink.Free;
TRecentStrings(FList).OnChange := nil;
FList.Free;
FItems.Free;
FItems := nil;
inherited Destroy;
end;
procedure TMRUManager.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = RecentMenu) and (Operation = opRemove) then
RecentMenu := nil;
end;
procedure TMRUManager.GetItemData(var Caption: string; var ShortCut: TShortCut;
UserData: Longint);
begin
if Assigned(FOnGetItem) then FOnGetItem(Self, Caption, ShortCut, UserData);
end;
procedure TMRUManager.DoClick(const RecentName, Caption: string; UserData: PtrInt);
begin
if Assigned(FOnClick) then FOnClick(Self, RecentName, Caption, UserData);
end;
procedure TMRUManager.MenuItemClick(Sender: TObject);
var
I: Integer;
begin
if Sender is TMenuItem then begin
I := TMenuItem(Sender).Tag;
if (I >= 0) and (I < FList.Count) then
try
DoClick(FList[I], TMenuItem(Sender).Caption, PtrInt(FList.Objects[I]));
finally
if RemoveOnSelect then Remove(FList[I]);
end;
end;
end;
function TMRUManager.GetCapacity: Integer;
begin
Result := TRecentStrings(FList).MaxSize;
end;
procedure TMRUManager.SetCapacity(Value: Integer);
begin
TRecentStrings(FList).MaxSize := Value;
end;
function TMRUManager.GetMode: TRecentMode;
begin
Result := TRecentStrings(FList).Mode;
end;
procedure TMRUManager.SetMode(Value: TRecentMode);
begin
TRecentStrings(FList).Mode := Value;
end;
function TMRUManager.GetStorage: TFormPlacement;
begin
Result := FIniLink.Storage;
end;
procedure TMRUManager.SetStorage(Value: TFormPlacement);
begin
FIniLink.Storage := Value;
end;
procedure TMRUManager.SetAutoEnable(Value: Boolean);
begin
if FAutoEnable <> Value then begin
FAutoEnable := Value;
if Assigned(FRecentMenu) and FAutoEnable then
FRecentMenu.Enabled := FRecentMenu.Count > 0;
end;
end;
procedure TMRUManager.SetStartAccel(Value: Cardinal);
begin
if FStartAccel <> Value then begin
FStartAccel := Value;
if FAutoUpdate then UpdateRecentMenu;
end;
end;
procedure TMRUManager.SetAccelDelimiter(Value: TAccelDelimiter);
begin
if FAccelDelimiter <> Value then begin
FAccelDelimiter := Value;
if FAutoUpdate and ShowAccelChar then UpdateRecentMenu;
end;
end;
procedure TMRUManager.SetShowAccelChar(Value: Boolean);
begin
if FShowAccelChar <> Value then begin
FShowAccelChar := Value;
if FAutoUpdate then UpdateRecentMenu;
end;
end;
procedure TMRUManager.Add(const RecentName: string; UserData: Longint);
begin
FList.AddObject(RecentName, TObject(PtrInt(UserData)));
end;
procedure TMRUManager.Clear;
begin
FList.Clear;
end;
procedure TMRUManager.Remove(const RecentName: string);
begin
TRecentStrings(FList).Remove(RecentName);
end;
procedure TMRUManager.AddMenuItem(Item: TMenuItem);
begin
if Assigned(Item) then begin
FRecentMenu.Add(Item);
FItems.Add(Item);
end;
end;
{ Must be moved to Controls}
Function GetShortHint(const Hint: WideString): WideString;
var
I: Integer;
begin
I := Pos('|', Hint);
if I = 0 then
Result := Hint
else
Result := Copy(Hint, 1, I - 1);
end;
function GetLongHint(const Hint: WideString): WideString;
var
I: Integer;
begin
I := Pos('|', Hint);
if I = 0 then
Result := Hint
else
Result := Copy(Hint, I + 1, Maxint);
end;
{ Must be moved to Menus}
function NewLine: TMenuItem;
begin
Result := TMenuItem.Create(nil);
Result.Caption := '-';
end;
function NewItem(const ACaption: WideString; AShortCut: TShortCut;
AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext;
const AName: string): TMenuItem;
begin
Result := TMenuItem.Create(nil);
with Result do
begin
Caption := ACaption;
ShortCut := AShortCut;
OnClick := AOnClick;
HelpContext := hCtx;
Checked := AChecked;
Enabled := AEnabled;
Name := AName;
end;
end;
procedure TMRUManager.UpdateRecentMenu;
const
AccelDelimChars: array[TAccelDelimiter] of Char = (#9, ' ');
var
I: Integer;
L: Cardinal;
S: string;
C: string[2];
ShortCut: TShortCut;
Item: TMenuItem;
begin
ClearRecentMenu;
if Assigned(FRecentMenu) then begin
if (FList.Count > 0) and (FRecentMenu.Count > 0) then
AddMenuItem(NewLine);
for I := 0 to FList.Count - 1 do begin
if (FSeparateSize > 0) and (I > 0) and (I mod FSeparateSize = 0) then
AddMenuItem(NewLine);
S := FList[I];
ShortCut := scNone;
GetItemData(S, ShortCut, Longint(PtrInt(FList.Objects[I])));
Item := NewItem(GetShortHint(S), ShortCut, False, True,
@MenuItemClick, 0, '');
Item.Hint := GetLongHint(S);
if FShowAccelChar then begin
L := Cardinal(I) + FStartAccel;
if L < 10 then
C := '&' + Char(Ord('0') + L)
else if L <= (Ord('Z') + 10) then
C := '&' + Char(L + Ord('A') - 10)
else
C := ' ';
Item.Caption := C + AccelDelimChars[FAccelDelimiter] + Item.Caption;
end;
Item.Tag := I;
AddMenuItem(Item);
end;
if AutoEnable then FRecentMenu.Enabled := FRecentMenu.Count > 0;
end;
end;
procedure TMRUManager.ClearRecentMenu;
var
Item: TMenuItem;
begin
while FItems.Count > 0 do begin
Item := TMenuItem(FItems.Last);
if Assigned(FRecentMenu) and (FRecentMenu.IndexOf(Item) >= 0) then
Item.Free;
FItems.Remove(Item);
end;
if Assigned(FRecentMenu) and AutoEnable then
FRecentMenu.Enabled := FRecentMenu.Count > 0;
end;
procedure TMRUManager.SetRecentMenu(Value: TMenuItem);
begin
ClearRecentMenu;
FRecentMenu := Value;
{$IFDEF MSWINDOWS}
if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
UpdateRecentMenu;
end;
procedure TMRUManager.SetSeparateSize(Value: Word);
begin
if FSeparateSize <> Value then begin
FSeparateSize := Value;
if FAutoUpdate then UpdateRecentMenu;
end;
end;
procedure TMRUManager.ListChanged(Sender: TObject);
begin
if Sender=nil then ;
Change;
if FAutoUpdate then UpdateRecentMenu;
end;
procedure TMRUManager.IniSave(Sender: TObject);
begin
if Sender=nil then ;
if (Name <> '') and (FIniLink.IniObject <> nil) then
InternalSave(FIniLink.IniObject, FIniLink.RootSection +
GetDefaultSection(Self));
end;
procedure TMRUManager.IniLoad(Sender: TObject);
begin
if Sender=nil then ;
if (Name <> '') and (FIniLink.IniObject <> nil) then
InternalLoad(FIniLink.IniObject, FIniLink.RootSection +
GetDefaultSection(Self));
end;
procedure TMRUManager.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TMRUManager.DoReadItem(Ini: TCustomIniFile; const Section: string;
Index: Integer; var RecentName: string; var UserData: Longint);
begin
if Assigned(FOnReadItem) then
FOnReadItem(Self, Ini, Section, Index, RecentName, UserData)
else begin
RecentName := Ini.ReadString( Section, Format(siRecentItem, [Index]), RecentName);
UserData := Ini.ReadInteger( Section, Format(siRecentData, [Index]), UserData);
end;
end;
procedure TMRUManager.DoWriteItem(Ini: TCustomIniFile; const Section: string;
Index: Integer; const RecentName: string; UserData: Longint);
begin
if Assigned(FOnWriteItem) then
FOnWriteItem(Self, Ini, Section, Index, RecentName, UserData)
else begin
Ini.WriteString(Section, Format(siRecentItem, [Index]), RecentName);
if UserData = 0 then
Ini.DeleteKey(Section, Format(siRecentData, [Index]))
else
Ini.WriteInteger(Section, Format(siRecentData, [Index]), UserData);
end;
end;
procedure TMRUManager.InternalLoad(Ini: TCustomIniFile; const Section: string);
var
I: Integer;
S: string;
UserData: Longint;
AMode: TRecentMode;
begin
AMode := Mode;
FList.BeginUpdate;
try
FList.Clear;
Mode := rmInsert;
for I := TRecentStrings(FList).MaxSize - 1 downto 0 do begin
S := '';
UserData := 0;
DoReadItem(Ini,Section, I, S, UserData);
if S <> '' then Add(S, UserData);
end;
finally
Mode := AMode;
FList.EndUpdate;
end;
end;
procedure TMRUManager.InternalSave(Ini: TCustomInifile; const Section: string);
var
I: Integer;
begin
Ini.EraseSection(Section);
for I := 0 to FList.Count - 1 do
DoWriteItem(Ini, Section, I, FList[I], Longint(PtrInt(FList.Objects[I])));
end;
procedure TMRUManager.LoadFromIni(Ini: TCustomIniFile; const Section: string);
begin
InternalLoad(Ini, Section);
end;
procedure TMRUManager.SaveToIni(Ini: TCustomIniFile; const Section: string);
begin
InternalSave(Ini, Section);
end;
{ TRecentStrings }
constructor TRecentStrings.Create;
begin
inherited Create;
FMaxSize := 10;
FMode := rmInsert;
end;
Function Max(A,B : Integer) : Integer;
begin
If A>B then
Result:=A
else
Result:=B;
end;
Function Min(A,B : Integer) : Integer;
begin
If A>B then
Result:=B
else
Result:=A;
end;
procedure TRecentStrings.SetMaxSize(Value: Integer);
begin
if FMaxSize <> Value then begin
FMaxSize := Max(1, Value);
DeleteExceed;
end;
end;
procedure TRecentStrings.DeleteExceed;
var
I: Integer;
begin
BeginUpdate;
try
if FMode = rmInsert then begin
for I := Count - 1 downto FMaxSize do Delete(I);
end
else begin { rmAppend }
while Count > FMaxSize do Delete(0);
end;
finally
EndUpdate;
end;
end;
procedure TRecentStrings.Remove(const S: String);
var
I: Integer;
begin
I := IndexOf(S);
if I >= 0 then Delete(I);
end;
function TRecentStrings.Add(const S: String): Integer;
begin
Result := IndexOf(S);
if Result >= 0 then begin
if FMode = rmInsert then Move(Result, 0)
else { rmAppend } Move(Result, Count - 1);
end
else begin
BeginUpdate;
try
if FMode = rmInsert then Insert(0, S)
else { rmAppend } Insert(Count, S);
DeleteExceed;
finally
EndUpdate;
end;
end;
if FMode = rmInsert then Result := 0
else { rmAppend } Result := Count - 1;
end;
procedure TRecentStrings.AddStrings(NewStrings: TStrings);
var
I: Integer;
begin
BeginUpdate;
try
if FMode = rmInsert then begin
for I := Min(NewStrings.Count, FMaxSize) - 1 downto 0 do
AddObject(NewStrings[I], NewStrings.Objects[I]);
end
else begin { rmAppend }
for I := 0 to Min(NewStrings.Count, FMaxSize) - 1 do
AddObject(NewStrings[I], NewStrings.Objects[I]);
end;
DeleteExceed;
finally
EndUpdate;
end;
end;
end.

BIN
components/rx/trunk/rx_laz/mrulist.res Normal file
View File

Binary file not shown.

1100
components/rx/trunk/rx_laz/placement.pp Normal file
View File

File diff suppressed because it is too large Load Diff

772
components/rx/trunk/rx_laz/strholder.pp Normal file
View File

@ -0,0 +1,772 @@
{*******************************************************}
{ }
{ Delphi VCL Extensions (RX) }
{ }
{ Copyright (c) 1996 AO ROSNO }
{ Copyright (c) 1997, 1998 Master-Bank }
{ }
{*******************************************************}
{$mode objfpc}
{$H+}
unit StrHolder;
interface
uses SysUtils, Classes, LResources;
type
{$ifdef usevariant}
TMacroData = Variant;
{$else}
TMacroData = AnsiString;
{$endif}
{ TMacro }
TMacros = class;
TMacroTextEvent = procedure(Sender: TObject; Data: TMacroData;
var Text: string) of object;
TMacro = class(TCollectionItem)
private
FName: string;
FData: TMacroData;
FOnGetText: TMacroTextEvent;
function IsMacroStored: Boolean;
function GetText: string;
function GetMacros: TMacros;
protected
function GetDisplayName: string; override;
procedure SetDisplayName(const Value: string); override;
procedure GetMacroText(var AText: string);
function GetAsTMacroData: TMacroData;
procedure SetAsTMacroData(Value: TMacroData);
public
constructor Create(ACollection: TCollection); override;
procedure Assign(Source: TPersistent); override;
procedure Clear;
function IsEqual(Value: TMacro): Boolean;
property Macros: TMacros read GetMacros;
property Text: string read GetText;
published
property Name: string read FName write SetDisplayName;
property Value: TMacroData read GetAsTMacroData write SetAsTMacroData stored IsMacroStored;
property OnGetText: TMacroTextEvent read FOnGetText write FOnGetText;
end;
{ TMacros }
TMacros = class(TOwnedCollection)
private
function GetMacroValue(const MacroName: string): TMacroData;
procedure SetMacroValue(const MacroName: string;
const Value: TMacroData);
function GetItem(Index: Integer): TMacro;
procedure SetItem(Index: Integer; Value: TMacro);
public
constructor Create(AOwner: TPersistent);
procedure AssignValues(Value: TMacros);
procedure AddMacro(Value: TMacro);
procedure RemoveMacro(Value: TMacro);
function CreateMacro(const MacroName: string): TMacro;
procedure GetMacroList(List: TList; const MacroNames: string);
function IndexOf(const AName: string): Integer;
function IsEqual(Value: TMacros): Boolean;
function ParseString(const Value: string; DoCreate: Boolean;
SpecialChar: Char): string;
function MacroByName(const Value: string): TMacro;
function FindMacro(const Value: string): TMacro;
property Items[Index: Integer]: TMacro read GetItem write SetItem; default;
property MacroValues[const MacroName: string]: TMacroData read GetMacroValue write SetMacroValue;
end;
{ TStrHolder }
TStrHolder = class(TComponent)
private
FStrings: TStrings;
FXorKey: string;
FMacros: TMacros;
FMacroChar: Char;
FOnExpandMacros: TNotifyEvent;
FOnChange: TNotifyEvent;
FOnChanging: TNotifyEvent;
function GetDuplicates: TDuplicates;
procedure SetDuplicates(Value: TDuplicates);
function GetSorted: Boolean;
procedure SetSorted(Value: Boolean);
procedure SetStrings(Value: TStrings);
procedure StringsChanged(Sender: TObject);
procedure StringsChanging(Sender: TObject);
procedure ReadStrings(Reader: TReader);
procedure WriteStrings(Writer: TWriter);
function GetCommaText: string;
procedure SetCommaText(const Value: string);
function GetCapacity: Integer;
procedure SetCapacity(NewCapacity: Integer);
procedure SetMacros(Value: TMacros);
procedure RecreateMacros;
procedure SetMacroChar(Value: Char);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure DefineProperties(Filer: TFiler); override;
procedure Changed; dynamic;
procedure Changing; dynamic;
procedure BeforeExpandMacros; dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Clear;
function MacroCount: Integer;
function MacroByName(const MacroName: string): TMacro;
function ExpandMacros: string;
property CommaText: string read GetCommaText write SetCommaText;
published
property Capacity: Integer read GetCapacity write SetCapacity default 0;
property MacroChar: Char read FMacroChar write SetMacroChar default '%';
property Macros: TMacros read FMacros write SetMacros;
property OnExpandMacros: TNotifyEvent read FOnExpandMacros write FOnExpandMacros;
property Duplicates: TDuplicates read GetDuplicates write SetDuplicates
default dupIgnore;
property KeyString: string read FXorKey write FXorKey stored False;
property Sorted: Boolean read GetSorted write SetSorted default False;
property Strings: TStrings read FStrings write SetStrings stored False;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
end;
Procedure Register;
implementation
{$R strholder.res}
uses
RTLConsts;
Procedure Register;
begin
RegisterComponents('Misc',[TStrHolder])
end;
function XorEncode(const Key, Source: string): string;
var
I: Integer;
C: Byte;
begin
Result := '';
for I := 1 to Length(Source) do begin
if Length(Key) > 0 then
C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(Source[I])
else
C := Byte(Source[I]);
Result := Result + AnsiLowerCase(IntToHex(C, 2));
end;
end;
function XorDecode(const Key, Source: string): string;
var
I: Integer;
C: Char;
begin
Result := '';
for I := 0 to Length(Source) div 2 - 1 do begin
C := Chr(StrToIntDef('$' + Copy(Source, (I * 2) + 1, 2), Ord(' ')));
if Length(Key) > 0 then
C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
Result := Result + C;
end;
end;
function ExtractName(const Items: string; var Pos: Integer): string;
var
I: Integer;
begin
I := Pos;
while (I <= Length(Items)) and (Items[I] <> ';') do Inc(I);
Result := Trim(Copy(Items, Pos, I - Pos));
if (I <= Length(Items)) and (Items[I] = ';') then Inc(I);
Pos := I;
end;
Type
TCharSet = Set of char;
function NameDelimiter(C: Char; Delims: TCharSet): Boolean;
begin
Result := (C in [' ', ',', ';', ')', #13, #10]) or (C in Delims);
end;
function IsLiteral(C: Char): Boolean;
begin
Result := C in ['''', '"'];
end;
procedure CreateMacros(List: TMacros; const Value: PChar; SpecialChar: Char; Delims: TCharSet);
var
CurPos, StartPos: PChar;
CurChar: Char;
Literal: Boolean;
EmbeddedLiteral: Boolean;
Name: string;
function StripLiterals(Buffer: PChar): string;
var
Len: Word;
TempBuf: PChar;
procedure StripChar(Value: Char);
begin
if TempBuf^ = Value then
StrMove(TempBuf, TempBuf + 1, Len - 1);
if TempBuf[StrLen(TempBuf) - 1] = Value then
TempBuf[StrLen(TempBuf) - 1] := #0;
end;
begin
Len := StrLen(Buffer) + 1;
TempBuf := AllocMem(Len);
Result := '';
try
StrCopy(TempBuf, Buffer);
StripChar('''');
StripChar('"');
Result := StrPas(TempBuf);
finally
FreeMem(TempBuf, Len);
end;
end;
begin
if SpecialChar = #0 then Exit;
CurPos := Value;
Literal := False;
EmbeddedLiteral := False;
repeat
CurChar := CurPos^;
if (CurChar = SpecialChar) and not Literal and ((CurPos + 1)^ <> SpecialChar) then
begin
StartPos := CurPos;
while (CurChar <> #0) and (Literal or not NameDelimiter(CurChar, Delims)) do begin
Inc(CurPos);
CurChar := CurPos^;
if IsLiteral(CurChar) then begin
Literal := Literal xor True;
if CurPos = StartPos + 1 then EmbeddedLiteral := True;
end;
end;
CurPos^ := #0;
if EmbeddedLiteral then begin
Name := StripLiterals(StartPos + 1);
EmbeddedLiteral := False;
end
else Name := StrPas(StartPos + 1);
if Assigned(List) then begin
if List.FindMacro(Name) = nil then
List.CreateMacro(Name);
end;
CurPos^ := CurChar;
StartPos^ := '?';
Inc(StartPos);
StrMove(StartPos, CurPos, StrLen(CurPos) + 1);
CurPos := StartPos;
end
else if (CurChar = SpecialChar) and not Literal and ((CurPos + 1)^ = SpecialChar) then
StrMove(CurPos, CurPos + 1, StrLen(CurPos) + 1)
else if IsLiteral(CurChar) then Literal := Literal xor True;
Inc(CurPos);
until CurChar = #0;
end;
{ TMacro }
constructor TMacro.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
{$ifdef usevariant}
FData := Unassigned;
{$else}
FData:='';
{$endif}
end;
procedure TMacro.Assign(Source: TPersistent);
begin
if (Source is TMacro) and (Source <> nil) then
begin
{$ifdef usevariant}
if VarIsEmpty(TMacro(Source).FData) then
Clear
else
{$endif}
Value := TMacro(Source).FData;
Name := TMacro(Source).Name;
end;
end;
function TMacro.GetDisplayName: string;
begin
if FName = '' then
Result := inherited GetDisplayName
else
Result := FName;
end;
procedure TMacro.SetDisplayName(const Value: string);
begin
if (Value <> '') and (AnsiCompareText(Value, FName) <> 0) and
(Collection is TMacros) and (TMacros(Collection).IndexOf(Value) >= 0) then
raise Exception.Create(SDuplicateString);
FName := Value;
inherited;
end;
procedure TMacro.GetMacroText(var AText: string);
begin
if Assigned(FOnGetText) then FOnGetText(Self, FData, AText);
end;
function TMacro.GetText: string;
begin
Result := FData;
GetMacroText(Result);
end;
function TMacro.GetMacros: TMacros;
begin
if Collection is TMacros then
Result := TMacros(Collection)
else
Result := nil;
end;
procedure TMacro.Clear;
begin
{$ifdef usevariant}
FData := Unassigned;
{$else}
FData := '';
{$endif}
end;
function TMacro.IsMacroStored: Boolean;
begin
{$ifdef usevariant}
Result := not VarIsEmpty(FData);
{$else}
Result := (FData<>'');
{$endif}
end;
function TMacro.GetAsTMacroData: TMacroData;
begin
Result := FData;
end;
procedure TMacro.SetAsTMacroData(Value: TMacroData);
begin
FData := Value;
end;
function TMacro.IsEqual(Value: TMacro): Boolean;
begin
{$ifdef usevariant}
Result := (VarType(FData) = VarType(Value.FData)) and
(VarIsEmpty(FData) or (FData = Value.FData)) and
(Name = Value.Name);
{$else}
Result := (FData=Value.FData) and
(Name = Value.Name);
{$endif}
end;
{ TMacros }
constructor TMacros.Create(AOwner: TPersistent);
begin
inherited Create(AOwner, TMacro);
end;
function TMacros.IndexOf(const AName: string): Integer;
begin
for Result := 0 to Count - 1 do
if AnsiCompareText(TMacro(Items[Result]).Name, AName) = 0 then Exit;
Result := -1;
end;
function TMacros.GetItem(Index: Integer): TMacro;
begin
Result := TMacro(inherited Items[Index]);
end;
procedure TMacros.SetItem(Index: Integer; Value: TMacro);
begin
inherited SetItem(Index, TCollectionItem(Value));
end;
procedure TMacros.AddMacro(Value: TMacro);
begin
Value.Collection := Self;
end;
procedure TMacros.RemoveMacro(Value: TMacro);
begin
if Value.Collection = Self then
Value.Collection := nil;
end;
function TMacros.CreateMacro(const MacroName: string): TMacro;
begin
Result := Add as TMacro;
Result.Name := MacroName;
end;
function TMacros.IsEqual(Value: TMacros): Boolean;
var
I: Integer;
begin
Result := Count = Value.Count;
if Result then
for I := 0 to Count - 1 do begin
Result := Items[I].IsEqual(Value.Items[I]);
if not Result then Break;
end;
end;
function TMacros.MacroByName(const Value: string): TMacro;
begin
Result := FindMacro(Value);
if Result = nil then
raise Exception.Create(SInvalidPropertyValue);
end;
function TMacros.FindMacro(const Value: string): TMacro;
var
I: Integer;
begin
for I := 0 to Count - 1 do begin
Result := TMacro(inherited Items[I]);
if AnsiCompareText(Result.Name, Value) = 0 then Exit;
end;
Result := nil;
end;
procedure TMacros.AssignValues(Value: TMacros);
var
I: Integer;
P: TMacro;
begin
BeginUpdate;
try
for I := 0 to Value.Count - 1 do begin
P := FindMacro(Value[I].Name);
if P <> nil then P.Assign(Value[I]);
end;
finally
EndUpdate;
end;
end;
function TMacros.ParseString(const Value: string; DoCreate: Boolean;
SpecialChar: Char): string;
var
Macros: TMacros;
begin
Result := Value;
Macros := TMacros.Create(Self.GetOwner);
try
CreateMacros(Macros, PChar(Result), SpecialChar, ['.']);
if DoCreate then begin
Macros.AssignValues(Self);
Self.Assign(Macros);
end;
finally
Macros.Free;
end;
end;
function TMacros.GetMacroValue(const MacroName: string): TMacroData;
{$ifdef usevariant}
var
I: Integer;
Macros: TList;
{$ENDIF}
begin
{$ifdef usevariant}
if Pos(';', MacroName) <> 0 then
begin
Macros := TList.Create;
try
GetMacroList(Macros, MacroName);
Result := VarArrayCreate([0, Macros.Count - 1], varVariant);
for I := 0 to Macros.Count - 1 do
Result[I] := TMacro(Macros[I]).Value;
finally
Macros.Free;
end;
end
else
{$else}
Result := MacroByName(MacroName).Value;
{$endif}
end;
procedure TMacros.SetMacroValue(const MacroName: string;
const Value: TMacroData);
var
I: Integer;
Macros: TList;
begin
if Pos(';', MacroName) <> 0 then begin
Macros := TList.Create;
try
GetMacroList(Macros, MacroName);
for I := 0 to Macros.Count - 1 do
TMacro(Macros[I]).Value := Value[I];
finally
Macros.Free;
end;
end
else MacroByName(MacroName).Value := Value;
end;
procedure TMacros.GetMacroList(List: TList; const MacroNames: string);
var
Pos: Integer;
begin
Pos := 1;
while Pos <= Length(MacroNames) do
List.Add(MacroByName(ExtractName(MacroNames, Pos)));
end;
{ TStrHolder }
constructor TStrHolder.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStrings := TStringList.Create;
FMacros := TMacros.Create(Self);
FMacroChar := '%';
TStringList(FStrings).OnChange := @StringsChanged;
TStringList(FStrings).OnChanging := @StringsChanging;
end;
destructor TStrHolder.Destroy;
begin
FOnChange := nil;
FOnChanging := nil;
FMacros.Free;
FStrings.Free;
inherited Destroy;
end;
procedure TStrHolder.Assign(Source: TPersistent);
begin
if Source is TStrings then
FStrings.Assign(Source)
else if Source is TStrHolder then
FStrings.Assign(TStrHolder(Source).Strings)
else
inherited Assign(Source);
end;
procedure TStrHolder.AssignTo(Dest: TPersistent);
begin
if Dest is TStrings then
Dest.Assign(Strings)
else
inherited AssignTo(Dest);
end;
procedure TStrHolder.Changed;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TStrHolder.Changing;
begin
if Assigned(FOnChanging) then FOnChanging(Self);
end;
procedure TStrHolder.Clear;
begin
FStrings.Clear;
end;
function TStrHolder.GetCommaText: string;
begin
Result := FStrings.CommaText;
end;
procedure TStrHolder.SetCommaText(const Value: string);
begin
FStrings.CommaText := Value;
end;
function TStrHolder.GetCapacity: Integer;
begin
Result := FStrings.Capacity;
end;
procedure TStrHolder.SetCapacity(NewCapacity: Integer);
begin
FStrings.Capacity := NewCapacity;
end;
procedure TStrHolder.BeforeExpandMacros;
begin
if Assigned(FOnExpandMacros) then FOnExpandMacros(Self);
end;
procedure TStrHolder.SetMacros(Value: TMacros);
begin
FMacros.AssignValues(Value);
end;
procedure TStrHolder.RecreateMacros;
begin
if not (csReading in ComponentState) then
Macros.ParseString(FStrings.Text, True, MacroChar);
end;
procedure TStrHolder.SetMacroChar(Value: Char);
begin
if Value <> FMacroChar then begin
FMacroChar := Value;
RecreateMacros;
end;
end;
function TStrHolder.MacroCount: Integer;
begin
Result := Macros.Count;
end;
function TStrHolder.MacroByName(const MacroName: string): TMacro;
begin
Result := Macros.MacroByName(MacroName);
end;
function TStrHolder.ExpandMacros: string;
var
I, J, P, LiteralChars: Integer;
Macro: TMacro;
Found: Boolean;
begin
BeforeExpandMacros;
Result := FStrings.Text;
for I := Macros.Count - 1 downto 0 do
begin
Macro := Macros[I];
{$ifdef usevariant}
if VarIsEmpty(Macro.FData) then
Continue;
{$endif}
repeat
P := Pos(MacroChar + Macro.Name, Result);
Found := (P > 0) and ((Length(Result) = P + Length(Macro.Name)) or
NameDelimiter(Result[P + Length(Macro.Name) + 1], ['.']));
if Found then begin
LiteralChars := 0;
for J := 1 to P - 1 do
if IsLiteral(Result[J]) then Inc(LiteralChars);
Found := LiteralChars mod 2 = 0;
if Found then begin
Result := Copy(Result, 1, P - 1) + Macro.Text + Copy(Result,
P + Length(Macro.Name) + 1, MaxInt);
end;
end;
until not Found;
end;
end;
procedure TStrHolder.DefineProperties(Filer: TFiler);
function DoWrite: Boolean;
var
I: Integer;
Ancestor: TStrHolder;
begin
Ancestor := TStrHolder(Filer.Ancestor);
Result := False;
if (Ancestor <> nil) and (Ancestor.FStrings.Count = FStrings.Count) and
(KeyString = Ancestor.KeyString) and (FStrings.Count > 0) then
for I := 0 to FStrings.Count - 1 do begin
Result := CompareText(FStrings[I], Ancestor.FStrings[I]) <> 0;
if Result then Break;
end
else Result := (FStrings.Count > 0) or (Length(KeyString) > 0);
end;
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('StrData', @ReadStrings, @WriteStrings, DoWrite);
end;
function TStrHolder.GetSorted: Boolean;
begin
Result := TStringList(FStrings).Sorted;
end;
function TStrHolder.GetDuplicates: TDuplicates;
begin
Result := TStringList(FStrings).Duplicates;
end;
procedure TStrHolder.ReadStrings(Reader: TReader);
begin
Reader.ReadListBegin;
if not Reader.EndOfList then KeyString := Reader.ReadString;
FStrings.Clear;
while not Reader.EndOfList do
FStrings.Add(XorDecode(KeyString, Reader.ReadString));
Reader.ReadListEnd;
end;
procedure TStrHolder.SetDuplicates(Value: TDuplicates);
begin
TStringList(FStrings).Duplicates := Value;
end;
procedure TStrHolder.SetSorted(Value: Boolean);
begin
TStringList(FStrings).Sorted := Value;
end;
procedure TStrHolder.SetStrings(Value: TStrings);
begin
FStrings.Assign(Value);
end;
procedure TStrHolder.StringsChanged(Sender: TObject);
begin
if Sender=nil then ;
RecreateMacros;
if not (csReading in ComponentState) then Changed;
end;
procedure TStrHolder.StringsChanging(Sender: TObject);
begin
if Sender=nil then ;
if not (csReading in ComponentState) then Changing;
end;
procedure TStrHolder.WriteStrings(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
Writer.WriteString(KeyString);
for I := 0 to FStrings.Count - 1 do
Writer.WriteString(XorEncode(KeyString, FStrings[I]));
Writer.WriteListEnd;
end;
end.

BIN
components/rx/trunk/rx_laz/strholder.res Normal file
View File

Binary file not shown.

286
components/rx/trunk/rx_laz/tmrumanager.xpm Normal file
View File

@ -0,0 +1,286 @@
/* XPM */
static char *tmrumanager[] = {
/* columns rows colors chars-per-pixel */
"24 24 256 2",
" c black",
". c #800000",
"X c #008000",
"o c transparent",
"O c navy",
"+ c #800080",
"@ c #008080",
"# c #808080",
"$ c #C0C0C0",
"% c red",
"& c green",
"* c yellow",
"= c blue",
"- c magenta",
"; c cyan",
": c gray100",
"> c black",
", c black",
"< c black",
"1 c black",
"2 c black",
"3 c black",
"4 c black",
"5 c black",
"6 c black",
"7 c black",
"8 c black",
"9 c black",
"0 c black",
"q c black",
"w c black",
"e c black",
"r c black",
"t c black",
"y c black",
"u c black",
"i c black",
"p c black",
"a c black",
"s c black",
"d c black",
"f c black",
"g c black",
"h c black",
"j c black",
"k c black",
"l c black",
"z c black",
"x c black",
"c c black",
"v c black",
"b c black",
"n c black",
"m c black",
"M c black",
"N c black",
"B c black",
"V c black",
"C c black",
"Z c black",
"A c black",
"S c black",
"D c black",
"F c black",
"G c black",
"H c black",
"J c black",
"K c black",
"L c black",
"P c black",
"I c black",
"U c black",
"Y c black",
"T c black",
"R c black",
"E c black",
"W c black",
"Q c black",
"! c black",
"~ c black",
"^ c black",
"/ c black",
"( c black",
") c black",
"_ c black",
"` c black",
"' c black",
"] c black",
"[ c black",
"{ c black",
"} c black",
"| c black",
" . c black",
".. c black",
"X. c black",
"o. c black",
"O. c black",
"+. c black",
"@. c black",
"#. c black",
"$. c black",
"%. c black",
"&. c black",
"*. c black",
"=. c black",
"-. c black",
";. c black",
":. c black",
">. c black",
",. c black",
"<. c black",
"1. c black",
"2. c black",
"3. c black",
"4. c black",
"5. c black",
"6. c black",
"7. c black",
"8. c black",
"9. c black",
"0. c black",
"q. c black",
"w. c black",
"e. c black",
"r. c black",
"t. c black",
"y. c black",
"u. c black",
"i. c black",
"p. c black",
"a. c black",
"s. c black",
"d. c black",
"f. c black",
"g. c black",
"h. c black",
"j. c black",
"k. c black",
"l. c black",
"z. c black",
"x. c black",
"c. c black",
"v. c black",
"b. c black",
"n. c black",
"m. c black",
"M. c black",
"N. c black",
"B. c black",
"V. c black",
"C. c black",
"Z. c black",
"A. c black",
"S. c black",
"D. c black",
"F. c black",
"G. c black",
"H. c black",
"J. c black",
"K. c black",
"L. c black",
"P. c black",
"I. c black",
"U. c black",
"Y. c black",
"T. c black",
"R. c black",
"E. c black",
"W. c black",
"Q. c black",
"!. c black",
"~. c black",
"^. c black",
"/. c black",
"(. c black",
"). c black",
"_. c black",
"`. c black",
"'. c black",
"]. c black",
"[. c black",
"{. c black",
"}. c black",
"|. c black",
" X c black",
".X c black",
"XX c black",
"oX c black",
"OX c black",
"+X c black",
"@X c black",
"#X c black",
"$X c black",
"%X c black",
"&X c black",
"*X c black",
"=X c black",
"-X c black",
";X c black",
":X c black",
">X c black",
",X c black",
"<X c black",
"1X c black",
"2X c black",
"3X c black",
"4X c black",
"5X c black",
"6X c black",
"7X c black",
"8X c black",
"9X c black",
"0X c black",
"qX c black",
"wX c black",
"eX c black",
"rX c black",
"tX c black",
"yX c black",
"uX c black",
"iX c black",
"pX c black",
"aX c black",
"sX c black",
"dX c black",
"fX c black",
"gX c black",
"hX c black",
"jX c black",
"kX c black",
"lX c black",
"zX c black",
"xX c black",
"cX c black",
"vX c black",
"bX c black",
"nX c black",
"mX c black",
"MX c black",
"NX c black",
"BX c black",
"VX c black",
"CX c black",
"ZX c black",
"AX c black",
"SX c black",
"DX c black",
"FX c black",
"GX c black",
"HX c black",
"JX c black",
"KX c black",
"LX c black",
"PX c black",
"IX c black",
"UX c black",
/* pixels */
"o o o o o o o o o o o o o o o o o o o o o o o o ",
"o o o o o o o o o o o o o o o o o o o o o o o o ",
"o o o o o o o o o # # # # # # # # # # # o o o o ",
"o o o o o o o o o # : : : : : : : : : o o o o ",
"o o o o o o o o o # : O O O O O : : : o o o o ",
"o o o o o o o o o # : : : : : : : : : o o o o ",
"o o o o o o o o o # : O O O O : : : : o o o o ",
"o o o o o o o o o # : : : : : : : : : o o o o ",
"o o o o o o o o o # O O O O O O O O O o o o o ",
"o o o o o o o o o # O O : : : : : O O o o o o ",
"o o o o o o o o o # O O O O O O O O O o o o o ",
"o o o o o o o o o # : : : : : : : : : o o o o ",
"o o o o o o o : O O O O O O : : o o o o ",
"o * : * : : : : : : : : o o o o ",
"o ; * : : : : o o o o ",
"o ; : * : * : * : * : * o o o o ",
"o ; * : * : o o o o o o o o ",
"o ; : * : * : * : o o o o o o o o o o ",
"o ; * : * : o o o o o o o o o o o ",
"o ; * : * : * o o o o o o o o o o o ",
"o * o o o o o o o o o o o o o ",
"o o o o o o o o o o o o o o o o o o o o o ",
"o o o o o o o o o o o o o o o o o o o o o o o o ",
"o o o o o o o o o o o o o o o o o o o o o o o o "
};

286
components/rx/trunk/rx_laz/tstrholder.xpm Normal file
View File

@ -0,0 +1,286 @@
/* XPM */
static char *tstrholder[] = {
/* columns rows colors chars-per-pixel */
"24 24 256 2",
" c black",
". c #800000",
"X c #008000",
"o c transparent",
"O c navy",
"+ c #800080",
"@ c #008080",
"# c #808080",
"$ c #C0C0C0",
"% c red",
"& c green",
"* c yellow",
"= c blue",
"- c magenta",
"; c cyan",
": c gray100",
"> c black",
", c black",
"< c black",
"1 c black",
"2 c black",
"3 c black",
"4 c black",
"5 c black",
"6 c black",
"7 c black",
"8 c black",
"9 c black",
"0 c black",
"q c black",
"w c black",
"e c black",
"r c black",
"t c black",
"y c black",
"u c black",
"i c black",
"p c black",
"a c black",
"s c black",
"d c black",
"f c black",
"g c black",
"h c black",
"j c black",
"k c black",
"l c black",
"z c black",
"x c black",
"c c black",
"v c black",
"b c black",
"n c black",
"m c black",
"M c black",
"N c black",
"B c black",
"V c black",
"C c black",
"Z c black",
"A c black",
"S c black",
"D c black",
"F c black",
"G c black",
"H c black",
"J c black",
"K c black",
"L c black",
"P c black",
"I c black",
"U c black",
"Y c black",
"T c black",
"R c black",
"E c black",
"W c black",
"Q c black",
"! c black",
"~ c black",
"^ c black",
"/ c black",
"( c black",
") c black",
"_ c black",
"` c black",
"' c black",
"] c black",
"[ c black",
"{ c black",
"} c black",
"| c black",
" . c black",
".. c black",
"X. c black",
"o. c black",
"O. c black",
"+. c black",
"@. c black",
"#. c black",
"$. c black",
"%. c black",
"&. c black",
"*. c black",
"=. c black",
"-. c black",
";. c black",
":. c black",
">. c black",
",. c black",
"<. c black",
"1. c black",
"2. c black",
"3. c black",
"4. c black",
"5. c black",
"6. c black",
"7. c black",
"8. c black",
"9. c black",
"0. c black",
"q. c black",
"w. c black",
"e. c black",
"r. c black",
"t. c black",
"y. c black",
"u. c black",
"i. c black",
"p. c black",
"a. c black",
"s. c black",
"d. c black",
"f. c black",
"g. c black",
"h. c black",
"j. c black",
"k. c black",
"l. c black",
"z. c black",
"x. c black",
"c. c black",
"v. c black",
"b. c black",
"n. c black",
"m. c black",
"M. c black",
"N. c black",
"B. c black",
"V. c black",
"C. c black",
"Z. c black",
"A. c black",
"S. c black",
"D. c black",
"F. c black",
"G. c black",
"H. c black",
"J. c black",
"K. c black",
"L. c black",
"P. c black",
"I. c black",
"U. c black",
"Y. c black",
"T. c black",
"R. c black",
"E. c black",
"W. c black",
"Q. c black",
"!. c black",
"~. c black",
"^. c black",
"/. c black",
"(. c black",
"). c black",
"_. c black",
"`. c black",
"'. c black",
"]. c black",
"[. c black",
"{. c black",
"}. c black",
"|. c black",
" X c black",
".X c black",
"XX c black",
"oX c black",
"OX c black",
"+X c black",
"@X c black",
"#X c black",
"$X c black",
"%X c black",
"&X c black",
"*X c black",
"=X c black",
"-X c black",
";X c black",
":X c black",
">X c black",
",X c black",
"<X c black",
"1X c black",
"2X c black",
"3X c black",
"4X c black",
"5X c black",
"6X c black",
"7X c black",
"8X c black",
"9X c black",
"0X c black",
"qX c black",
"wX c black",
"eX c black",
"rX c black",
"tX c black",
"yX c black",
"uX c black",
"iX c black",
"pX c black",
"aX c black",
"sX c black",
"dX c black",
"fX c black",
"gX c black",
"hX c black",
"jX c black",
"kX c black",
"lX c black",
"zX c black",
"xX c black",
"cX c black",
"vX c black",
"bX c black",
"nX c black",
"mX c black",
"MX c black",
"NX c black",
"BX c black",
"VX c black",
"CX c black",
"ZX c black",
"AX c black",
"SX c black",
"DX c black",
"FX c black",
"GX c black",
"HX c black",
"JX c black",
"KX c black",
"LX c black",
"PX c black",
"IX c black",
"UX c black",
/* pixels */
"o o o o o o o o o o o o o o o o o o o o o o o o ",
"o o o o o o o o o o o o o o ",
"o o o o o o o o o o : : : : : : : : : : o o ",
"o o o o o o o o o o : = = = = = = = = : o o ",
"o o o o o o o o o o : : : : : : : : : : o o ",
"o o o o o o o o o o : = = = = = = = = : o o ",
"o o o o o o o o o o : : : : : : : : : : o o ",
"o o o o o o o o o o : = = = = = = = = : o o ",
"o o o o o o o o o o : : : : : : : : : : o o ",
"o o o o o o : = = = = = = = = : o o ",
"o o o # # # # : : : : : : : : : : o o ",
"o o # # # # # # # : = = = = = = = = : o o ",
"o o # # # # # # # : : : : : : : : : : o o ",
"o o # # # # # # # # o o o ",
"o o # # # # # # # # o o o o o o ",
"o o : : $ $ # # o o o o o o ",
"o o : : $ $ $ $ $ $ $ $ $ $ # # o o o o o o ",
"o o : : $ $ $ $ $ $ $ $ $ $ # # o o o o o o ",
"o o : : $ $ $ $ $ $ $ $ $ $ # # o o o o o o ",
"o o : : $ $ $ $ $ $ $ $ $ $ # # o o o o o o ",
"o o : : $ $ $ $ $ $ $ $ $ $ # # o o o o o o ",
"o o o $ $ $ $ $ $ $ $ $ $ o o o o o o o ",
"o o o o o o o o o o o o o o ",
"o o o o o o o o o o o o o o o o o o o o o o o o "
};