baservfrm.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       Ancestor for all RichViewActions forms.         }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

unit BaseRVFrm;

interface

{$I RichViewActions.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls,
  Dialogs, Buttons, RVScroll, RVXPTheme,
  {$IFDEF USERVKSDEVTE}
  te_controls, te_forms, te_extctrls, CRVPP, RVPP, RichView, te_scrolladapt,
  te_adapter, te_theme,
  {$ENDIF}
  {$IFDEF USERVTNT}
  TntStdCtrls, TntButtons, TntExtCtrls, TntComCtrls, TntForms,
  {$ENDIF}
  RVOfficeRadioBtn, ComCtrls;

type
  {$IFDEF USERVTNT}
  TfrmRVBaseBase = TTntForm;
  {$ELSE}
  TfrmRVBaseBase = TForm;
  {$ENDIF}

  TfrmRVBase = class(TfrmRVBaseBase)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure btnHelpClick(Sender: TObject);
  protected
    procedure SetUseXPThemes(const Value: Boolean); virtual;
    procedure LocalizeSpecialControls;
    function FindButtonWithModalResult(ModalResult: TModalResult): TButton;
    procedure AddHelpButton;
    function GetOkButton: TButton; dynamic;
    function GetCancelButton: TButton;
    {$IFDEF RVASKINNED}
    procedure OnCreateThemedControl(OldControl, NewControl: TControl); dynamic;
    function IsThemeAllowedFor(Component: TComponent): Boolean; dynamic;
    procedure MoveChildren(OldControl, NewControl: TWinControl);
    {$ENDIF}
    {$IFDEF USERVKSDEVTE}
    function IsTeFormAllowed: Boolean; dynamic;
    procedure ApplyKSDevThemeEngine;
    {$ENDIF}
    {$IFDEF USERVTNT}
    procedure ApplyTntControls;
    {$ENDIF}
  public
    { Public declarations }
    {$IFDEF USERVKSDEVTE}
    tef: TTeForm;
    {$ENDIF}
    procedure Localize; dynamic;
    function GetRadioButtonChecked(rb: TControl): Boolean;
    procedure SetRadioButtonChecked(rb: TControl; Checked: Boolean);
    function GetCheckBoxChecked(cb: TControl): Boolean;
    procedure SetCheckBoxChecked(cb: TControl; Checked: Boolean);
    function GetCheckBoxState(cb: TControl): TCheckBoxState;
    procedure SetCheckBoxState(cb: TControl; State: TCheckBoxState);
    procedure SetFormCaption(const Caption: String);
    procedure SetControlCaption(Control: TControl; const Caption: String);
    function GetEditText(Edit: TControl): String;
    procedure SetEditSelText(Edit: TControl; const s: String);
    function GetEditFont(Edit: TControl): TFont;
    function GetEditSelStart(Edit: TControl): Integer;
    function GetEditSelLength(Edit: TControl): Integer;
    procedure SetEditSelStart(Edit: TControl; Value: Integer);
    procedure SetEditSelLength(Edit: TControl; Value: Integer);
    function GetXBoxItemCount(Box: TControl): Integer;
    procedure ClearXBoxItems(Box: TControl);
    procedure XBoxItemsAddObject(Box: TControl; const s: String; obj: TObject;
      SysLanguage: Boolean = False);
    function GetXBoxObject(Box: TControl; Index: Integer): TObject;
    procedure SetXBoxItems(Box: TControl; Items: TStrings);
    function GetXBoxItemIndex(Box: TControl): Integer;
    function CreateXBoxItemsCopy(Box: TControl): TStringList;
    function GetPageControlActivePageIndex(pc: TControl): Integer;
    function GetPageControlActivePage(pc: TControl): TWinControl;
    procedure SetPageControlActivePage(pc: TControl; Page: TControl);
    procedure SetXBoxItemIndex(Box: TControl; ItemIndex: Integer);
    procedure SetListBoxSorted(Box: TControl);
    procedure HideTabSheet(ts: TControl);
    function IsTabSheetVisible(ts: TControl): Boolean;
    property UseXPThemes: Boolean write SetUseXPThemes;
  end;

function _GetWideString(const s: String): WideString;
function _GetString(const s: WideString): String;

implementation
uses RichViewActions, RVColorCombo, RVALocalize, RVColorGrid, ColorRVFrm, RVUni;

{$R *.dfm}

function _GetWideString(const s: String): WideString;
begin
  Result := RVU_RawUnicodeToWideString(RVU_AnsiToUnicode(
    RVU_Charset2CodePage(RVA_GetCharset), s));
end;

function _GetString(const s: WideString): String;
begin
  Result := RVU_UnicodeToAnsi(RVU_Charset2CodePage(RVA_GetCharset),
    RVU_GetRawUnicode(s));
end;


{ TfrmRVBase }

function GetRevBiDiModeAlignment(Alignment: TAlignment): TAlignment;
begin
  case Alignment of
    taLeftJustify:  Result := taRightJustify;
    taRightJustify: Result := taLeftJustify;
    else Result := Alignment;
  end;
end;

procedure TfrmRVBase.SetUseXPThemes(const Value: Boolean);
var i: Integer;
begin
  for i := 0 to ComponentCount -1 do
    if Components[i] is TRVScroller then
      TRVScroller(Components[i]).UseXPThemes := Value
    else if Components[i] is TRVOfficeRadioButton then
      TRVOfficeRadioButton(Components[i]).UseXPThemes := Value
    else if Components[i] is TRVOfficeRadioGroup then
      TRVOfficeRadioGroup(Components[i]).UseXPThemes := Value
    else if Components[i] is TRVColorCombo then
      TRVColorCombo(Components[i]).UseXPThemes := Value
    else if Components[i] is TRVColorGrid then
      TRVColorGrid(Components[i]).Flat := Value and
       Assigned(RV_IsAppThemed) and RV_IsAppThemed and RV_IsThemeActive;
end;

procedure TfrmRVBase.FormCreate(Sender: TObject);
var i: Integer;
    Help: String;
begin
  Font.Charset := RVA_GetCharset;
  if Screen.Fonts.IndexOf(RVA_DialogFontName)>=0 then
    Font.Name := RVA_DialogFontName;
  UseXPThemes := RVA_UseXPThemes;
  {
  for i := 0 to ComponentCount-1 do
    if Components[i] is TRVOfficeRadioButton then
      TRVOfficeRadioButton(Components[i]).Font.Charset := RVA_GetCharset
    else if Components[i] is TRVOfficeRadioGroup then
      TRVOfficeRadioGroup(Components[i]).Font.Charset := RVA_GetCharset;
  }
  if RVA_GetCharset in [ARABIC_CHARSET, HEBREW_CHARSET] then begin
    BiDiMode := bdRightToLeft;
    FlipChildren(True);
    if not SysLocale.MiddleEast then
      for i := 0 to ComponentCount-1 do
        if Components[i] is TCustomLabel then
          TLabel(Components[i]).Alignment := GetRevBiDiModeAlignment(TLabel(Components[i]).Alignment)
        else if Components[i] is TCustomCheckBox then
          TCheckBox(Components[i]).Alignment := GetRevBiDiModeAlignment(TCheckBox(Components[i]).Alignment)
        else if Components[i] is TRadioButton then
          TRadioButton(Components[i]).Alignment := GetRevBiDiModeAlignment(TRadioButton(Components[i]).Alignment)
  end;
  Localize;
  Help := RVA_GetHelpFile;
  if Help<>'' then begin
    HelpFile := ExtractFilePath(Application.ExeName)+Help;
    AddHelpButton;
  end;
  {$IFDEF USERVKSDEVTE}
  ApplyKSDevThemeEngine;
  {$ENDIF}
  {$IFDEF USERVTNT}
  ApplyTntControls;
  {$ENDIF}
end;

procedure TfrmRVBase.Localize;
begin
  LocalizeSpecialControls;
end;

procedure TfrmRVBase.LocalizeSpecialControls;
var i: Integer;
    ColorPresent: Boolean;
begin
  ColorPresent := False;
  for i := 0 to ComponentCount-1 do
    if Components[i] is TRVColorCombo then begin
      TRVColorCombo(Components[i]).TransparentCaption := RVA_GetS(rvam_cl_Transparent);
      TRVColorCombo(Components[i]).AutoCaption := RVA_GetS(rvam_cl_Auto);
      ColorPresent := True;
      end
    else if Components[i] is TRVColorGrid then
      ColorPresent := True;
  if ColorPresent then
    for i := 0 to ColorCount-1 do
      Colors[i].Name := PChar(RVA_GetPC(TRVAMessageID(ord(rvam_cl_Black)+i)));
end;

function TfrmRVBase.FindButtonWithModalResult(
  ModalResult: TModalResult): TButton;
var i: Integer;
begin
  for i := 0 to ComponentCount-1 do
    if (Components[i] is TButton) and
       (TButton(Components[i]).ModalResult=ModalResult) then begin
      Result := TButton(Components[i]);
      exit;
    end;
  Result := nil;
end;

procedure TfrmRVBase.AddHelpButton;
var btnOk, btnCancel, btnHelp: TButton;
begin
  btnOk := GetOkButton;
  if btnOk=nil then
    exit;
  btnCancel := GetCancelButton;
  if btnCancel=nil then
    exit;
  btnHelp := TButton.Create(Self);
  btnHelp.Caption := RVA_GetS(rvam_btn_Help);
  with btnCancel do
    btnHelp.SetBounds(Left, Top, Width, Height);
  with btnOk do
    btnCancel.SetBounds(Left, Top, Width, Height);
  btnOk.Left := btnCancel.Left - (btnHelp.Left-btnCancel.Left);
  btnOk.Top := btnCancel.Top - (btnHelp.Top-btnCancel.Top);
  btnHelp.Parent := Self;
  btnHelp.TabOrder := btnCancel.TabOrder+1;
  btnHelp.OnClick := btnHelpClick;
end;

function TfrmRVBase.GetOkButton: TButton;
begin
  Result := FindButtonWithModalResult(mrOk);
end;

function TfrmRVBase.GetCancelButton: TButton;
begin
  Result := FindButtonWithModalResult(mrCancel);
end;

procedure TfrmRVBase.btnHelpClick(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;

function TfrmRVBase.GetRadioButtonChecked(rb: TControl): Boolean;
begin
  {$IFDEF USERVKSDEVTE}
  Result := (rb as TTeRadioButton).Checked;
  {$ELSE}
  {$IFDEF USERVTNT}
  Result := (rb as TTntRadioButton).Checked;
  {$ELSE}
  Result := (rb as TRadioButton).Checked;
  {$ENDIF}
  {$ENDIF}
end;

procedure TfrmRVBase.SetRadioButtonChecked(rb: TControl; Checked: Boolean);
begin
  {$IFDEF USERVKSDEVTE}
  (rb as TTeRadioButton).Checked := Checked;
  {$ELSE}
  {$IFDEF USERVTNT}
  (rb as TTntRadioButton).Checked := Checked;
  {$ELSE}
  (rb as TRadioButton).Checked := Checked;;
  {$ENDIF}
  {$ENDIF}
end;

function TfrmRVBase.GetCheckBoxChecked(cb: TControl): Boolean;
begin
  {$IFDEF USERVKSDEVTE}
  Result := (cb as TTeCheckBox).Checked;
  {$ELSE}
  {$IFDEF USERVTNT}
  Result := (cb as TTntCheckBox).Checked;
  {$ELSE}
  Result := (cb as TCheckBox).Checked;
  {$ENDIF}
  {$ENDIF}
end;

procedure TfrmRVBase.SetCheckBoxChecked(cb: TControl; Checked: Boolean);
begin
  {$IFDEF USERVKSDEVTE}
  (cb as TTeCheckBox).Checked := Checked;
  {$ELSE}
  {$IFDEF USERVTNT}
  (cb as TTntCheckBox).Checked := Checked;
  {$ELSE}
  (cb as TCheckBox).Checked := Checked;;
  {$ENDIF}
  {$ENDIF}
end;

function TfrmRVBase.GetCheckBoxState(cb: TControl): TCheckBoxState;
begin
  {$IFDEF USERVKSDEVTE}
  Result := TCheckBoxState((cb as TTeCheckBox).State);
  {$ELSE}
  {$IFDEF USERVTNT}
  Result := (cb as TTntCheckBox).State;
  {$ELSE}
  Result := (cb as TCheckBox).State;
  {$ENDIF}
  {$ENDIF}
end;

procedure TfrmRVBase.SetCheckBoxState(cb: TControl; State: TCheckBoxState);
begin
  {$IFDEF USERVKSDEVTE}
  (cb as TTeCheckBox).State := TTeCheckBoxState(State);
  {$ELSE}
  {$IFDEF USERVTNT}
  (cb as TTntCheckBox).State := State;
  {$ELSE}
  (cb as TCheckBox).State := State;
  {$ENDIF}
  {$ENDIF}
end;

function TfrmRVBase.GetXBoxItemIndex(Box: TControl): Integer;
begin
  {$IFDEF USERVKSDEVTE}
  if Box is TTeComboBox then
    Result := (Box as TTeComboBox).ItemIndex
  else if Box is TTeListBox then
    Result := (Box as TTeListBox).ItemIndex
  else
    Result := (Box as TTeRadioGroup).ItemIndex
  {$ELSE}
  {$IFDEF USERVTNT}
  if Box is TTntComboBox then
    Result := (Box as TTntComboBox).ItemIndex
  else if Box is TTntListBox then
    Result := (Box as TTntListBox).ItemIndex
  else
    Result := (Box as TTntRadioGroup).ItemIndex
  {$ELSE}
  if Box is TComboBox then
    Result := (Box as TComboBox).ItemIndex
  else if Box is TListBox then
    Result := (Box as TListBox).ItemIndex
  else
    Result := (Box as TRadioGroup).ItemIndex
  {$ENDIF}
  {$ENDIF}
end;

function TfrmRVBase.CreateXBoxItemsCopy(Box: TControl): TStringList;
begin
  Result := TStringList.Create;
  {$IFDEF USERVKSDEVTE}
  if Box is TTeComboBox then
    Result.Assign((Box as TTeComboBox).Items)
  else if Box is TTeListBox then
    Result.Assign((Box as TTeListBox).Items)
  else
    Result.Assign((Box as TTeRadioGroup).Items)
  {$ELSE}
  {$IFDEF USERVTNT}
  if Box is TTntComboBox then
    Result.Assign((Box as TTntComboBox).Items)
  else if Box is TTntListBox then
    Result.Assign((Box as TTntListBox).Items)
  else
    Result.Assign((Box as TTntRadioGroup).Items)
  {$ELSE}
  if Box is TComboBox then
    Result.Assign((Box as TComboBox).Items)
  else if Box is TListBox then
    Result.Assign((Box as TListBox).Items)
  else
    Result.Assign((Box as TRadioGroup).Items)
  {$ENDIF}
  {$ENDIF}
end;

function TfrmRVBase.GetXBoxObject(Box: TControl; Index: Integer): TObject;
begin
  {$IFDEF USERVKSDEVTE}
  if Box is TTeComboBox then
    Result := (Box as TTeComboBox).Items.Objects[Index]
  else if Box is TTeListBox then
    Result := (Box as TTeListBox).Items.Objects[Index]
  else
    Result := (Box as TTeRadioGroup).Items.Objects[Index]
  {$ELSE}
  {$IFDEF USERVTNT}
  if Box is TTntComboBox then
    Result := (Box as TTntComboBox).Items.Objects[Index]
  else if Box is TTntListBox then
    Result := (Box as TTntListBox).Items.Objects[Index]
  else
    Result := (Box as TTntRadioGroup).Items.Objects[Index]
  {$ELSE}
  if Box is TComboBox then
    Result := (Box as TComboBox).Items.Objects[Index]
  else if Box is TListBox then
    Result := (Box as TListBox).Items.Objects[Index]
  else
    Result := (Box as TRadioGroup).Items.Objects[Index]
  {$ENDIF}
  {$ENDIF}
end;

procedure TfrmRVBase.SetXBoxItems(Box: TControl; Items: TStrings);
begin
  {$IFDEF USERVKSDEVTE}
  if Box is TTeComboBox then
    (Box as TTeComboBox).Items := Items
  else if Box is TTeListBox then
    (Box as TTeListBox).Items := Items
  else
    (Box as TTeRadioGroup).Items := Items
  {$ELSE}
  {$IFDEF USERVTNT}
  if Box is TTntComboBox then
    (Box as TTntComboBox).Items.Assign(Items)
  else if Box is TTntListBox then
    (Box as TTntListBox).Items.Assign(Items)
  else
    (Box as TTntRadioGroup).Items.Assign(Items)
  {$ELSE}
  if Box is TComboBox then
    (Box as TComboBox).Items := Items