⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sctvopt.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 5 页
字号:
unit SctVOpt;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }


interface
{$I ace.inc}

uses
  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, pageman,sctvar, menus, grids,sctrep,
{$ifdef WIN32}
  windows;
{$else}
  winprocs, wintypes;
{$endif}

const
  Ace_RefreshVarLists = (wm_User+0);


type
  TAceRefreshVarLists = TWMNoParams;
  TAceDSOptionsState = set of (dsoUpdatingVars, dsoRefreshLists);

  TSctDSVariableOptions = class(TForm)
    DataSourcePanel: TPanel;
    Panel6: TPanel;
    FieldsPanel: TPanel;
    flist: TListBox;
    clistPopup: TPopupMenu;
    SelectAll1: TMenuItem;
    Delete1: TMenuItem;
    flistpopup: TPopupMenu;
    flistSelectAll: TMenuItem;
    ExprListPopup: TPopupMenu;
    ExprDelete: TMenuItem;
    ExprSelectAll: TMenuItem;
    TotalListPopup: TPopupMenu;
    TotalDelete: TMenuItem;
    TotalSelectAll: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    flistAdd: TMenuItem;
    totalpanel: TPanel;
    ButtonPanel: TPanel;
    Button1: TButton;
    TotalVarList: TListBox;
    TotalVarPanel: TPanel;
    DataSourceList: TStringGrid;
    Button2: TButton;
    ExprAdd: TMenuItem;
    TotalLabel: TLabel;
    totalLevelLabel: TLabel;
    TotalVariableLabel: TLabel;
    Label1: TLabel;
    SelectAllUnused1: TMenuItem;
    TotalSelectAllUnused: TMenuItem;
    ExprUnused: TMenuItem;
    DataSourceListPanel: TPanel;
    DataSourceLabel: TLabel;
    AutoLabel: TLabel;
    DSLevelLabel: TLabel;
    DSListPopup: TPopupMenu;
    RevertDsgItem: TMenuItem;
    String1: TMenuItem;
    Integer1: TMenuItem;
    Float1: TMenuItem;
    Boolean1: TMenuItem;
    DateTime1: TMenuItem;
    Blob1: TMenuItem;
    Memo1: TMenuItem;
    Graphic1: TMenuItem;
    DBVarPanel: TPanel;
    DBVarList: TListBox;
    Panel5: TPanel;
    DBLabel: TLabel;
    DBSourceLabel: TLabel;
    DBFieldLabel: TLabel;
    DBLevelLabel: TLabel;
    Label2: TLabel;
    DBListPopup: TPopupMenu;
    DBDelete: TMenuItem;
    DBSelectUnused: TMenuItem;
    DBSelectAll: TMenuItem;
    Add1: TMenuItem;
    ExprPanel: TPanel;
    ExprVarPanel: TPanel;
    ExprLevelLabel: TLabel;
    ExprLabel: TLabel;
    ExprEventLabel: TLabel;
    ExprTypeLabel: TLabel;
    ExprVarList: TListBox;
    DataSourceZoom: TSpeedButton;
    ExprZoom: TSpeedButton;
    TotalZoom: TSpeedButton;
    DbVarZoom: TSpeedButton;
    FieldZoom: TSpeedButton;
    VarPanel: TPanel;
    Panel3: TPanel;
    VarZoom: TSpeedButton;
    Panel7: TPanel;
    clist: TListBox;
    ZOOMIN: TSpeedButton;
    ZOOMOUT: TSpeedButton;
    Button3: TButton;
    DeleteDsgItem: TMenuItem;
    AddDsgItem: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure flistDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure flistDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure clistDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure clistDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TotalVarListDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TotalVarListDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure ExprSelectAllClick(Sender: TObject);
    procedure TotalSelectAllClick(Sender: TObject);
    procedure flistSelectAllClick(Sender: TObject);
    procedure SelectAll1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure flistAddClick(Sender: TObject);
    procedure TotalDeleteClick(Sender: TObject);
    procedure ExprDeleteClick(Sender: TObject);
    procedure TotalVarListClick(Sender: TObject);
    procedure ExprVarListClick(Sender: TObject);
    procedure clistClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure clistDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure DataSourceListDrawCell(Sender: TObject; Col, Row: Longint;
      Rect: TRect; State: TGridDrawState);
    procedure DataSourceListClick(Sender: TObject);
    procedure DataSourcePanelResize(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ExprAddClick(Sender: TObject);
    procedure clistPopupPopup(Sender: TObject);
    procedure flistpopupPopup(Sender: TObject);
    procedure ExprListPopupPopup(Sender: TObject);
    procedure TotalListPopupPopup(Sender: TObject);
    procedure flistClick(Sender: TObject);
    procedure TotalVarListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ExprVarListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure SelectAllUnused1Click(Sender: TObject);
    procedure TotalSelectAllUnusedClick(Sender: TObject);
    procedure ExprUnusedClick(Sender: TObject);
    procedure flistDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure RevertDsgItemClick(Sender: TObject);
    procedure DSListPopupPopup(Sender: TObject);
    procedure DBVarListClick(Sender: TObject);
    procedure DBVarListDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DBVarListDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure DBVarListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure DBDeleteClick(Sender: TObject);
    procedure DBSelectUnusedClick(Sender: TObject);
    procedure DBSelectAllClick(Sender: TObject);
    procedure DBListPopupPopup(Sender: TObject);
    procedure Add1Click(Sender: TObject);
    procedure DataSourceZoomClick(Sender: TObject);
    procedure FieldZoomClick(Sender: TObject);
    procedure DataSourceListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3Click(Sender: TObject);
    procedure DeleteDsgItemClick(Sender: TObject);
    procedure AddDsgItemClick(Sender: TObject);


  private
    { Private declarations }

    DsgList, ExprList, TotalList, DBList: TList;
    FDSOptionsState: TAceDSOptionsState;
    DataSourceZoomed, ExprZoomed, TotalZoomed, DBVarZoomed: Boolean;
    FieldZoomed, VarZoomed: Boolean;

{$ifdef AceBDE}
    procedure UpdateDSG(Dsg: TSctDataSourceGuide);
{$endif}

    procedure RefreshLists;
    function VarUsed(MyVar: TSctVAr): Boolean;
    procedure SelectComponent(Comp: TComponent);
    procedure UnSelectStuff(Component: TObject);
    procedure SelectUnused(List: TListBox);
    procedure AceRefreshVarLists(var Message: TAceRefreshVarLists); message Ace_RefreshVarLists;



{$ifdef AceBDE}
    procedure FillDsgVarList(DSG: TSctDataSourceGuide; List: TList);
    procedure FillDsgFieldList(DSG: TSctDataSourceGuide; List: TStringList);

    procedure UpdateDsgList;
    procedure UpdateCFList;
    procedure UpdateDBVarList;
{$endif}

    procedure UpdateExprList;
    procedure UpdateTotalList;

    function GetGroupPage: TSctGroupPage;
    function DsgOk: Boolean;
{$ifdef AceBDE}
    function GetFullDSName: String;
    function GetDataSourceGuide(FullDSName: String): TSctDataSourceGuide;
    function GetDbVar(DSG: TSctDataSourceGuide; FieldName: String): TSctDbVar;
    procedure AddDbVar(DSG: TSctDataSourceGuide; FieldName: String);
{$endif}
    procedure DeleteVar(MyVar: TSctVar);

{$ifdef AceBDE}
    procedure CListDelete;
    procedure FListDefine;
    procedure Optimize;
{$endif}
    function GetVar(VarName: String): TSctVar;
    procedure AddTotal(List: TListBox);
    procedure AddManualDBVar(List: TListBox);
    procedure DeleteETList(ListBox: TListBox);
    procedure SetMyButton(btn: TSpeedButton; Sender: TObject; var Zoomed: Boolean);
  public
    { Public declarations }
    PageManager: TSctPageManager;
    function UpdateVars: Boolean;
    procedure ObjectChanged;
  end;


var
  SctDSVariableOptions: TSctDSVariableOptions;

implementation

uses sctutil,sctctrl, sctvhelp, sctdata, aceutil
  {$ifndef WIN32} , libmain
  {$else}  , AceRtfC 
  {$endif}
  {$ifdef AceBDE}
    ,db {$ifndef VCL130PLUS} ,dbtables {$endif}
  {$endif}
   ;

{$R *.DFM}

procedure ClearList(List: TList);
begin
  if List <> nil then
  begin
    while List.Count > 0 do
    begin
      TObject(List.Items[0]).Free;
      List.Delete(0);
    end;
  end;
end;

procedure UnSelect(ListBox: TListBox);
var
  Spot: Integer;
begin
  for Spot := 0 to ListBox.Items.Count - 1 do ListBox.Selected[Spot] := False;
end;


{procedure DeleteSelected(List: TListBox);
var
  Spot: Integer;
begin
  List.Tag := 1;
  if List.SelCount > 0 then
  begin
    Spot := 0;
    while (List.SelCount > 0) And (Spot < List.Items.Count) do
    begin
      if List.Selected[Spot] then
      begin
        List.Items.Delete(Spot);
        Spot := 0;
      end else Inc(Spot);
    end;
  end;
  List.Tag := 0;
end;
 }
{procedure MoveSelected(FromList, ToList: TListBox);
var
  Spot: Integer;
begin
  if FromList.SelCount > 0 then
  begin
    for Spot := 0 to FromList.Items.Count - 1 do
    begin
      if FromList.Selected[Spot] then
        ToList.Items.AddObject( FromList.Items[Spot], FromList.Items.Objects[Spot] );
    end;
    DeleteSelected(FromList);
  end;
end;
 }


type
  TDsgItem = class(TObject)
  public
    CreateVariables: Boolean;
    DataSourceName: String;
    UpdateLevelName: String;
    CheckRect: TRect;
  end;
  TTotalItem = class(TObject)
  public
    TotalName: String;
    TotalLevelName: String;
    TotalVarName: String;
    Used, LevelMatch: Boolean;
  end;
  TExprItem = class(TObject)
  public
    ExprName: String;
    ExprLevelName: String;
    ExprEventName: String;
    ExprTypeName: String;
    Used: Boolean;
  end;
  TDBItem = class(TObject)
  public
    DBName, DataSourceName, DataField, LevelName: String;
    Used, LevelMatch: Boolean;
  end;


{ TSctDSVariableOptions }
procedure TSctDSVariableOptions.FormShow(Sender: TObject);
begin
  RefreshLists;
  DataSourceListClick(DataSourceList);
end;

procedure TSctDSVariableOptions.RefreshLists;
var
  pg: TSctGroupPage;
begin
  if Not (dsoRefreshLists in FDSOptionsState) then
  begin
    Include(FDSOptionsState, dsoRefreshLists);

    pg := GetGroupPage;
    if pg <> nil then
    begin
{$ifdef AceBDE}
      UpdateDsgList;
      UpdateCFList;
      UpdateDBVarList;
{$endif}
      UpdateExprList;
      UpdateTotalList;

    end;
    Application.ProcessMessages;
    Exclude(FDSOptionsState, dsoRefreshLists);
  end;

end;

procedure TSctDSVariableOptions.FormCreate(Sender: TObject);
begin
  DataSourceZoomed := False;
  ExprZoomed := False;
  TotalZoomed := False;
  DBVarZoomed := False;
  FieldZoomed := False;
  VarZoomed := False;

  PageManager := nil;
  DsgList := TList.Create;
  TotalList := TList.Create;
  ExprList := TList.Create;
  DBList := TList.Create;

  FDSOptionsState := [];

  if Screen.Width < 800 then
  begin
    ClientHeight := 450;
    ClientWidth := 600;
  end else
  begin
    ClientHeight := 500;
    ClientWidth := 700;
  end;
  if Screen.PixelsPerInch > 96 then Font.Size := 7;

  FieldZoomClick(nil);
  DataSourceZoomClick(nil);
end;

procedure TSctDSVariableOptions.FormDestroy(Sender: TObject);
begin
  ClearList(DsgList);
  if DsgList <> nil then DsgList.Free;
  ClearList(TotalList);
  if TotalList <> nil then TotalList.Free;
  ClearList(ExprList);
  if ExprList <> nil then ExprList.Free;
  ClearList(DBList);
  if DBList <> nil then DBList.Free;
end;

procedure TSctDSVariableOptions.flistDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
{$ifdef AceBDE}
  CListDelete;
{$endif}
end;

procedure TSctDSVariableOptions.flistDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if (Source = clist) And DsgOk then
    Accept := Not TDsgItem(DSGList.Items[DataSourceList.Row]).CreateVariables
  else Accept := False;
end;

procedure TSctDSVariableOptions.clistDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
{$ifdef AceBDE}
  FListDefine;
{$endif}
end;

procedure TSctDSVariableOptions.clistDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = flist);
end;

{$ifdef AceBDE}
procedure TSctDSVariableOptions.UpdateDSG(DSG: TSctDataSourceGuide);
var
  Spot: Integer;
  rvar: TSctDBVar;
  rvars: TList;
  fields: TStringList;
begin
  if DSG <> nil then
  begin
    rvars := TList.Create;
    fields := TStringList.Create;
    FillDsgVarList(DSG, rvars);
    FillDsgFieldList(DSG, fields);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -