teefilterseditor.pas

BCB第三方组件

var tmp : Integer;
begin
  tmp:=Filters.ItemIndex;
  CurrentFilter.Free;

  Filters.Items.Delete(Filters.ItemIndex);

  if tmp>=Filters.Items.Count then
     tmp:=Filters.Items.Count-1;

  if tmp>=0 then
  begin
    Filters.ItemIndex:=tmp;
    FiltersClick(Self);
  end
  else
    ClearProperties;

  EnableButtons;
  PageProps.Visible:=Filters.ItemIndex<>-1;

  Preview;
end;

procedure TFiltersEditor.Swap(A,B:Integer);
var tmp : TTeeFilter;
begin
  Filters.Items.Exchange(A,B);
  tmp:=FilterItems.Item[B];
  FilterItems.Item[A].Index:=B;
  tmp.Index:=A;
  EnableButtons;
  Preview;
end;

procedure TFiltersEditor.BMoveUpClick(Sender: TObject);
begin
  with Filters do
  if ItemIndex>0 then
     Swap(ItemIndex,ItemIndex-1);
end;

procedure TFiltersEditor.BMoveDownClick(Sender: TObject);
begin
  with Filters do
  if (ItemIndex<>-1) and (ItemIndex<Items.Count-1) then
     Swap(ItemIndex,ItemIndex+1);
end;

procedure TFiltersEditor.FormShow(Sender: TObject);
var t : Integer;
begin
  Backup:=TFilterItems.Create(Self,TTeeFilter);

  if Assigned(FilterItems) then
  begin
    Backup.Assign(FilterItems);

    for t:=0 to FilterItems.Count-1 do
    begin
      Filters.Items.AddObject(FilterItems[t].Description,FilterItems[t]);
      Filters.Checked[t]:=FilterItems[t].Enabled;
    end;
  end;

  PageProps.ActivePage:=Properties;

  if Filters.Items.Count>0 then
  begin
    Filters.ItemIndex:=0;
    FiltersClick(Self);
    Preview;
  end;

  PageProps.Visible:=Filters.Items.Count>0;
end;

procedure TFiltersEditor.Scaled1Click(Sender: TObject);
begin
  Scaled1.Checked:=not Scaled1.Checked;
  CBScaled.Checked:=Scaled1.Checked;

  Preview;
end;

procedure TFiltersEditor.Button1Click(Sender: TObject);
begin
  FilterItems:=Backup;
end;

procedure TFiltersEditor.FormDestroy(Sender: TObject);
begin
  Backup.Free;
  IBitmap.Free;
end;

procedure TFiltersEditor.CBPreviewClick(Sender: TObject);
begin
  CBScaled.Enabled:=CBPreview.Checked;

  if CBPreview.Checked then
     Preview
  else
     Image.BackImage:=nil;
end;

procedure TFiltersEditor.CBScaledClick(Sender: TObject);
begin
  Scaled1.Checked:=CBScaled.Checked;
  Preview;
end;

{ TFormCreator }

Constructor TFormCreator.Create(AOwner:TComponent);
begin
  inherited;
  FParent:=AOwner as TWinControl;
  Items:=TFormItems.Create;
end;

Destructor TFormCreator.Destroy;
begin
  while Items.Count>0 do
  begin
    TFormItem(Items[0]).Free;
    Items.Delete(0);
  end;

  Items.Free;
  inherited;
end;

function TFormCreator.AddCheckBox(const PropName,
  ACaption: String; OnChange:TNotifyEvent=nil): TCheckBox;
begin
  result:=TCheckBox.Create(FParent);

  with result do
  begin
    Parent:=FParent;
    SetBounds(4,IPosY,75,16);
    Caption:=ACaption;

    {$IFDEF D5}
    Checked:=GetPropValue(Instance,PropName);
    {$ENDIF}

    OnClick:=CheckBoxChanged;
    Inc(IPosY,Height+2);
    Tag:={$IFDEF CLR}Variant{$ELSE}Integer{$ENDIF}(AddItem(PropName,OnChange));
  end;
end;

function TFormCreator.AddItem(const PropName:String; AOnChange:TNotifyEvent=nil):TFormItem;
begin
  result:=TFormItem.Create;
  result.PropName:=PropName;
  result.OnChange:=AOnChange;
  Items.Add(result);
end;

function TFormCreator.AddScroll(const PropName: String; AMin,
  AMax: Integer): TScrollBar;
begin
  result:=TScrollBar.Create(FParent);

  with result do
  begin
    Parent:=FParent;
    SetBounds(4,IPosY,FParent.Width-8,16);
    Min:=AMin;
    Max:=AMax;

    {$IFDEF D5}
    Position:=GetPropValue(Instance,PropName);
    {$ENDIF}

    OnChange:=ScrollChanged;
    Inc(IPosY,Height+6);
    Tag:={$IFDEF CLR}Variant{$ELSE}Integer{$ENDIF}(AddItem(PropName));
  end;
end;

procedure TFormCreator.ScrollChanged(Sender:TObject);
begin
  ChangeProp(Sender,(Sender as TScrollBar).Position);
end;

procedure TFormCreator.ComboChanged(Sender:TObject);
begin
  ChangeProp(Sender,(Sender as TComboBox).ItemIndex);
end;

procedure TFormCreator.CheckBoxChanged(Sender:TObject);
begin
  ChangeProp(Sender,(Sender as TCheckBox).Checked);
end;

procedure TFormCreator.ChangeProp(Sender:TObject; const Value:Variant);
var tmp : TFormItem;
begin
  if not IChanging then
  begin
    tmp:=TFormItem((Sender as TComponent).Tag);

    {$IFDEF D5}
    SetPropValue(Instance,tmp.PropName,Value);
    {$ENDIF}

    if Assigned(tmp.OnChange) then
       tmp.OnChange(Sender);

    FOnChange(Instance);
  end;
end;

procedure TFormCreator.ColorChanged(Sender:TObject);
begin
  FOnChange(Instance);
end;

procedure TFormCreator.EditChanged(Sender:TObject);
begin
  ChangeProp(Sender,(Sender as TEdit).Text);
end;

function TFormCreator.AddColor(const PropName,ACaption: String): TButton;
begin
  result:=TButtonColor.Create(FParent);

  with result as TButtonColor do
  begin
    Parent:=FParent;
    Caption:=ACaption;
    LinkProperty(Self.Instance,PropName);
    Left:=4;
    Top:=IPosY;
    OnClick:=ColorChanged;
    Inc(IPosY,Height+6);
    Tag:={$IFDEF CLR}Variant{$ELSE}Integer{$ENDIF}(AddItem(PropName));
  end;
end;

function TFormCreator.AddCombo(const PropName: String): TComboBox;

  function GetReadableEnum(const S:String):String;
  var i : Integer;
  begin
    result:=S;

    //if ReadableEnums then
    begin
      while Length(result)>0 do
      begin
        if result[1]=UpCase(result[1]) then
           break
        else
           Delete(result,1,1)
      end;

      i:=2;
      while i<Length(result) do
      begin
        if result[i]=UpCase(result[i]) then
        begin
          Insert(' ',result,i);
          Inc(i,2);
        end
        else
           Inc(i);
      end;

      if result='' then
         result:=S;
    end;
  end;

{$IFDEF D5}
var P  : {$IFDEF CLR}TPropInfo{$ELSE}PPropInfo{$ENDIF};
    D  : {$IFDEF CLR}TTypeData{$ELSE}PTypeData{$ENDIF};
    t  : Integer;
    P2 : {$IFDEF CLR}TTypeInfo{$ELSE}PTypeInfo{$ENDIF};
{$ENDIF}
begin
  result:=TComboFlat.Create(FParent);

  with result do
  begin
    Parent:=FParent;
    SetBounds(4,IPosY,Parent.Width-8,16);
    Style:=csDropDownList;
    Inc(IPosY,Height+6);
    OnChange:=ComboChanged;

    {$IFDEF D5}
    P:=GetPropInfo(Instance,PropName);

    if Assigned(P) then
    begin
      P2:=P.{$IFDEF CLR}TypeInfo{$ELSE}PropType^{$ENDIF};

      // Warning: BaseType pending at VCL.Net TypInfo.pas
      D:={$IFNDEF CLR}GetTypeData{$ENDIF}(GetTypeData(P2){$IFNDEF CLR}.BaseType^{$ENDIF});

      for t:=D.MinValue to D.MaxValue do
          Items.Add(GetReadableEnum(GetEnumName(P2, t)));

      ItemIndex:=GetEnumValue(P2,GetPropValue(Instance,PropName));
    end;
    {$ENDIF}

    Tag:={$IFDEF CLR}Variant{$ELSE}Integer{$ENDIF}(Self.AddItem(PropName));
  end;
end;

{$IFNDEF D5}
const
  cHotKeyPrefix = '&'; // Do not localize
{$ENDIF}

function TFormCreator.AddInteger(const PropName,ACaption:String; AMin,AMax:Integer): TEdit;
const
  SameRow=True;
begin
  result:=TEdit.Create(FParent);

  with TLabel.Create(FParent) do
  begin
    Parent:=FParent;
    Left:=4;
    Top:=IPosY+4;

    if ACaption='' then Caption:=PropName
                   else Caption:=ACaption;

    if not SameRow then
       Inc(IPosY,Height+2);

    FocusControl:=result;

    if Pos(cHotKeyPrefix,Caption)=0 then
       Caption:=cHotKeyPrefix+Caption;
  end;

  with result do
  begin
    Parent:=FParent;

    if SameRow then
       SetBounds(44,IPosY,Parent.Width-52-16,16)
    else
       SetBounds(4,IPosY,Parent.Width-8-16,16);

    Inc(IPosY,Height+6);
    OnChange:=EditChanged;
    Tag:={$IFDEF CLR}Variant{$ELSE}Integer{$ENDIF}(Self.AddItem(PropName));

    with TUpDown.Create(FParent) do
    begin
      Parent:=FParent;
      Handle;
      Associate:=result;
      Max:=AMax;
      Min:=AMin;

      {$IFDEF D5}
      Position:=GetPropValue(Instance,PropName);
      {$ENDIF}
    end;
  end;
end;

procedure TFiltersEditor.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled:=False;
  FiltersClick(Self);
end;

procedure TFiltersEditor.ELeftChange(Sender: TObject);
begin
  if not IChanging then
  begin
    CurrentFilter.Region.Left:=UDLeft.Position;
    ChangedProperties(Self);
  end;
end;

procedure TFiltersEditor.ETopChange(Sender: TObject);
begin
  if not IChanging then
  begin
    CurrentFilter.Region.Top:=UDTop.Position;
    ChangedProperties(Self);
  end;
end;

procedure TFiltersEditor.EWidthChange(Sender: TObject);
begin
  if not IChanging then
  begin
    CurrentFilter.Region.Width:=UDWidth.Position;
    ChangedProperties(Self);
  end;
end;

procedure TFiltersEditor.EHeightChange(Sender: TObject);
begin
  if not IChanging then
  begin
    CurrentFilter.Region.Height:=UDHeight.Position;
    ChangedProperties(Self);
  end;
end;

{ TFormItems }

procedure TFormItems.Clear;
var t : Integer;
begin
  for t:=0 to Count-1 do Items[t].Free;
  inherited;
end;

function TFormItems.Get(Index: Integer): TFormItem;
begin
  result:=TFormItem({$IFOPT R-}List{$ELSE}inherited Items{$ENDIF}[Index]);
end;

end.