📄 rm_editordictionary.pas
字号:
{******************************************}
{ }
{ Report Machine v2.0 }
{ Data dictionary }
{ }
{******************************************}
unit RM_EditorDictionary;
interface
{$I RM.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus,
StdCtrls, ComCtrls, RM_Common, RM_Class, RM_Ctrls, RM_Parser, ExtCtrls, Buttons
{$IFDEF COMPILER4_UP}, ImgList{$ENDIF};
type
TRMDictionaryForm = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
btnOK: TButton;
btnCancel: TButton;
ImageList1: TImageList;
treeVariables: TTreeView;
cmbDataSets: TComboBox;
lstFields: TListBox;
Label3: TLabel;
Label4: TLabel;
SaveDialog1: TSaveDialog;
edtExpression: TEdit;
btnNewCategory: TSpeedButton;
btnNewVar: TSpeedButton;
btnEdit: TSpeedButton;
btnDel: TSpeedButton;
btnExpression: TSpeedButton;
PopupMenu1: TPopupMenu;
NewCategory1: TMenuItem;
NewVariable1: TMenuItem;
N1: TMenuItem;
Delete1: TMenuItem;
TabSheet2: TTabSheet;
lstAllDataSets: TListBox;
btnFieldAddOne: TSpeedButton;
btnFieldAddAll: TSpeedButton;
btnFieldDeleteOne: TSpeedButton;
btnFieldDeleteAll: TSpeedButton;
Label8: TLabel;
treeFieldAliases: TTreeView;
GroupBox1: TGroupBox;
Label2: TLabel;
chkFieldNoSelect: TCheckBox;
edtFieldAlias: TEdit;
btnPackDictionary: TButton;
TabSheet3: TTabSheet;
trvStyles: TTreeView;
Panel1: TPanel;
btnAddStyle: TSpeedButton;
btnEditStyle: TSpeedButton;
btnDeleteStyle: TSpeedButton;
GroupBox2: TGroupBox;
LabelHAlign: TLabel;
cmbHAlign: TComboBox;
LabelVAlign: TLabel;
cmbVAlign: TComboBox;
GroupBox3: TGroupBox;
Button1: TButton;
PaintBox1: TPaintBox;
FontDialog1: TFontDialog;
Button2: TButton;
btnClearDictionary: TButton;
procedure btnNewCategoryClick(Sender: TObject);
procedure btnNewVarClick(Sender: TObject);
procedure btnEditClick(Sender: TObject);
procedure btnDelClick(Sender: TObject);
procedure treeVariablesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure treeVariablesEdited(Sender: TObject; Node: TTreeNode; var S: string);
procedure btnOKClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure edtExpressionKeyPress(Sender: TObject; var Key: Char);
procedure btnExpressionClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure lstFieldsClick(Sender: TObject);
procedure treeVariablesChange(Sender: TObject; Node: TTreeNode);
procedure lstAllDataSetsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure btnFieldAddOneClick(Sender: TObject);
procedure btnFieldDeleteOneClick(Sender: TObject);
procedure treeFieldAliasesExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure edtFieldAliasKeyPress(Sender: TObject; var Key: Char);
procedure edtFieldAliasExit(Sender: TObject);
procedure btnFieldAddAllClick(Sender: TObject);
procedure btnFieldDeleteAllClick(Sender: TObject);
procedure cmbDataSetsClick(Sender: TObject);
procedure edtExpressionEnter(Sender: TObject);
procedure edtExpressionExit(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure chkFieldNoSelectClick(Sender: TObject);
procedure treeFieldAliasesChange(Sender: TObject; Node: TTreeNode);
procedure btnPackDictionaryClick(Sender: TObject);
procedure btnAddStyleClick(Sender: TObject);
procedure btnDeleteStyleClick(Sender: TObject);
procedure btnEditStyleClick(Sender: TObject);
procedure trvStylesEdited(Sender: TObject; Node: TTreeNode;
var S: String);
procedure trvStylesChange(Sender: TObject; Node: TTreeNode);
procedure Button1Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure cmbHAlignChange(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure btnClearDictionaryClick(Sender: TObject);
private
{ Private declarations }
FBusyFlag: Boolean;
FVariables: TRMVariables;
FFieldAliases: TRMVariables;
FActiveNode: TTreeNode;
FStyles: TRMTextStyles;
FBtnFillColor: TRMColorPickerButton;
procedure OnColorChangeEvent(Sender: TObject);
procedure Localize;
procedure ShowValue(aValue: string);
procedure AddFieldAlias(const aDataSet: string);
procedure FillValiableDataSets;
public
{ Public declarations }
CurReport: TRMReport;
end;
implementation
{$R *.DFM}
uses
RM_DataSet, RM_Const, RM_Const1, RM_Utils, RM_EditorExpr, RM_EditorFormat;
const
Dataset_INDEX = 1;
Field_CanSelect = 2;
Field_CannotSelect = 4;
Variable_Category = 5;
Variable_Variable = 6;
Field_INDEX = 13;
type
THackDictionary = class(TRMDictionary)
end;
procedure TRMDictionaryForm.Localize;
begin
Font.Name := RMLoadStr(SRMDefaultFontName);
Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
Font.Charset := StrToInt(RMLoadStr(SCharset));
RMSetStrProp(Self, 'Caption', rmRes + 340);
RMSetStrProp(TabSheet1, 'Caption', rmRes + 341);
RMSetStrProp(TabSheet2, 'Caption', rmRes + 342);
RMSetStrProp(Label3, 'Caption', rmRes + 344);
RMSetStrProp(Label4, 'Caption', rmRes + 345);
RMSetStrProp(btnNewCategory, 'Hint', rmRes + 347);
RMSetStrProp(btnNewVar, 'Hint', rmRes + 348);
RMSetStrProp(btnEdit, 'Hint', rmRes + 349);
RMSetStrProp(btnDel, 'Hint', rmRes + 350);
RMSetStrProp(GroupBox1, 'Caption', rmRes + 354);
RMSetStrProp(Label2, 'Caption', rmRes + 355);
RMSetStrProp(chkFieldNoSelect, 'Caption', rmRes + 356);
RMSetStrProp(Label8, 'Caption', rmRes + 358);
RMSetStrProp(btnPackDictionary, 'Caption', rmRes + 360);
RMSetStrProp(NewCategory1, 'Caption', rmRes + 347);
RMSetStrProp(NewVariable1, 'Caption', rmRes + 348);
RMSetStrProp(Delete1, 'Caption', rmRes + 350);
btnOK.Caption := RMLoadStr(SOk);
btnCancel.Caption := RMLoadStr(SCancel);
cmbHAlign.Items.Clear;
cmbHAlign.Items.Add(RMLoadStr(rmRes + 107));
cmbHAlign.Items.Add(RMLoadStr(rmRes + 109));
cmbHAlign.Items.Add(RMLoadStr(rmRes + 108));
cmbHAlign.Items.Add(RMLoadStr(rmRes + 114));
cmbVAlign.Items.Clear;
cmbVAlign.Items.Add(RMLoadStr(rmRes + 112));
cmbVAlign.Items.Add(RMLoadStr(rmRes + 111));
cmbVAlign.Items.Add(RMLoadStr(rmRes + 113));
RMSetStrProp(LabelHAlign, 'Caption', rmRes + 678);
RMSetStrProp(LabelVAlign, 'Caption', rmRes + 679);
RMSetStrProp(GroupBox2, 'Caption', rmRes + 680);
RMSetStrProp(TabSheet3, 'Caption', rmRes + 938);
RMSetStrProp(btnAddStyle, 'Hint', rmRes + 271);
RMSetStrProp(btnDeleteStyle, 'Hint', rmRes + 272);
RMSetStrProp(btnEditStyle, 'Hint', rmRes + 273);
RMSetStrProp(GroupBox3, 'Caption', rmRes + 274);
RMSetStrProp(Button1, 'Caption', rmRes + 275);
RMSetStrProp(Button2, 'Caption', rmRes + 276);
RMSetStrProp(FBtnFillColor, 'Caption', rmRes + 277);
end;
procedure TRMDictionaryForm.FillValiableDataSets;
var
lList: TStringList;
begin
lList := TStringList.Create;
try
CurReport.Dictionary.GetDataSets(lList, FFieldAliases);
lList.Sort;
cmbDataSets.Items.Assign(lList);
finally
lList.Free;
cmbDataSets.ItemIndex := 0;
cmbDataSetsClick(nil);
end;
end;
procedure TRMDictionaryForm.FormCreate(Sender: TObject);
begin
FVariables := TRMVariables.Create;
FFieldAliases := TRMVariables.Create;
FStyles := TRMTextStyles.Create(CurReport);
FBtnFillColor := TRMColorPickerButton.Create(Self);
with FBtnFillColor do
begin
Parent := GroupBox3;
Flat := False;
SetBounds(16, 56, 100, 25);
// Caption := RMLoadStr(rmRes + 528);
ColorType := rmptFill;
Caption := 'FillColor';
OnColorChange := OnColorChangeEvent;
end;
PageControl1.ActivePage := TabSheet1;
Localize;
end;
procedure TRMDictionaryForm.FormDestroy(Sender: TObject);
begin
FVariables.Free;
FFieldAliases.Free;
FStyles.Free;
end;
procedure TRMDictionaryForm.FormShow(Sender: TObject);
procedure _FillVariables; // 自定义变量
var
i: Integer;
liParentNode, liNode: TTreeNode;
s: string;
begin
FVariables.Assign(CurReport.Dictionary.Variables);
treeVariables.Items.Clear;
liParentNode := nil;
for i := 0 to FVariables.Count - 1 do
begin
s := FVariables.Name[i];
if (s <> '') and (s[1] = ' ') then // 目录
begin
liParentNode := treeVariables.Items.Add(nil, Copy(s, 2, 999));
liParentNode.ImageIndex := 5;
liParentNode.SelectedIndex := 5;
end
else // 变量
begin
if liParentNode = nil then
begin
FVariables.Insert(0, ' Category1','');
liParentNode := treeVariables.Items.Add(nil, 'Category1');
liParentNode.ImageIndex := 5;
liParentNode.SelectedIndex := 5;
end;
liNode := treeVariables.Items.AddChild(liParentNode, s);
liNode.ImageIndex := 6;
liNode.SelectedIndex := 6;
end;
end;
treeVariables.FullExpand;
if treeVariables.Items.Count > 0 then
treeVariables.Items[0].Selected := True;
end;
procedure _FillDataSets;
var
i, liIndex: Integer;
sl: TStringList;
liDataSetName: string;
begin
FFieldAliases.Assign(CurReport.Dictionary.FieldAliases);
treeFieldAliases.Items.Add(nil, RMLoadStr(rmRes + 352));
sl := TStringList.Create;
try
RMGetComponents(CurReport.Owner, TRMDataset, sl, nil);
sl.Sort;
for i := 0 to sl.Count - 1 do
begin
liDataSetName := sl[i];
liIndex := FFieldAliases.IndexOf(liDataSetName);
if liIndex >= 0 then
begin
if FFieldAliases.Value[liIndex] <> '' then
liDataSetName := liDataSetName + ' {' + FFieldAliases.Value[liIndex] + '}';
AddFieldAlias(liDataSetName)
end
else
lstAllDataSets.Items.Add(liDataSetName);
end;
lstAllDataSets.ItemIndex := 0;
treeFieldAliases.Items[0].Expand(False);
treeFieldAliases.Selected := treeFieldAliases.Items[0];
finally
sl.Free;
end;
end;
procedure _FillStyles;
var
i: Integer;
lNode: TTreeNode;
lStyle: TRMTextStyle;
begin
trvStyles.Items.BeginUpdate;
try
trvStyles.Items.Clear;
for i := 0 to FStyles.Count - 1 do
begin
lStyle := FStyles[i];
lNode := trvStyles.Items.AddChild(nil, lStyle.StyleName);
lNode.Data := lStyle;
lNode.ImageIndex := 6;
lNode.SelectedIndex := 6;
end;
finally
trvStyles.Items.EndUpdate;
end;
end;
begin
treeFieldAliases.Items.Clear;
FStyles.Assign(CurReport.TextStyles);
_FillStyles;
_FillVariables;
FillValiableDataSets;
_FillDataSets;
treeVariables.SetFocus;
end;
procedure TRMDictionaryForm.btnOKClick(Sender: TObject);
begin
CurReport.Dictionary.Variables.Assign(FVariables);
CurReport.Dictionary.FieldAliases.Assign(FFieldAliases);
CurReport.TextStyles.Assign(FStyles);
CurReport.TextStyles.Apply;
end;
procedure TRMDictionaryForm.btnNewCategoryClick(Sender: TObject);
var
ANode, TreeNode: TTreeNode;
s: string;
function CreateNewCategory: string;
var
i: Integer;
function FindCategory(s: string): Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to FVariables.Count - 1 do
begin
if AnsiCompareText(FVariables.Name[i], s) = 0 then
begin
Result := True;
break;
end;
end;
end;
begin
for i := 1 to 10000 do
begin
Result := 'Category' + IntToStr(i);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -