rm_flds1.pas

进销存·完整的·有数据库的·非常完整·只得参考

{******************************************}
{                                          }
{           Report Machine V2.0            }
{           Insert Fields dialog           }
{                                          }
{******************************************}

unit RM_flds1;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, RM_Common
{$IFDEF USE_TB2K}
  , TB2Item, TB2Dock, TB2Toolbar
{$ELSE}
{$IFDEF USE_INTERNALTB97}
  , RM_TB97Ctls, RM_TB97Tlbr, RM_TB97
{$ELSE}
  , TB97Ctls, TB97Tlbr, TB97
{$ENDIF}
{$ENDIF}
{$IFDEF Delphi6}, Variants{$ENDIF};

type
  TRMInsFieldsForm = class(TRMToolWin)
  private
    FieldsLB: TListBox;
    DatasetsLB: TListBox;
    Splitter: TSplitter;

    FHeightChanged: TNotifyEvent;
    FOnCloseEvent: TNotifyEvent;
    FBmp1, FBmp2, FBmp3, FBmp4: TBitmap;

    procedure OnFormCloseEvent(Sender: TObject);
    procedure OnVisibleChangedEvent(Sender: TObject);
    procedure Localize;
    procedure FillDatasetsLB;
    procedure GetFieldName;

    procedure DatasetsLBClick(Sender: TObject);
    procedure DatasetsLBDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure FieldsLBStartDrag(Sender: TObject;
      var DragObject: TDragObject);
  public
    DBField: string;
    DefHeight: Integer;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
//    procedure Grow;
    procedure RefreshData;
    property OnHeightChanged: TNotifyEvent read FHeightChanged write FHeightChanged;
    property OnCloseEvent: TNotifyEvent read FOnCloseEvent write FOnCloseEvent;
  end;

var
  RMFieldsDialog: TRMInsFieldsForm;

implementation

uses Registry, RM_Class, RM_Const, RM_Utils, RM_DBRel, RM_Const1;

var
  LastDB: string;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMInsFieldsForm }

constructor TRMInsFieldsForm.Create(AOwner: TComponent);
var
  Ini: TRegIniFile;
begin
  inherited Create(AOwner);

  DatasetsLB := TListBox.Create(Self);
  with DatasetsLB do
  begin
    Parent := Self;
    Align := alTop;
    Height := 145;
    ItemHeight := 16;
    Style := lbOwnerDrawFixed;
    OnClick := DatasetsLBClick;
    OnDrawItem := DatasetsLBDrawItem;
  end;
  Splitter := TSplitter.Create(Self);
  with Splitter do
  begin
    Parent := Self;
    Align := alTop;
    Top := 2;
  end;
  FieldsLB := TListBox.Create(Self);
  with FieldsLB do
  begin
    Parent := Self;
    SetBounds(0, 147, 392, 153);
    Align := alClient;
    DragMode := dmAutomatic;
    ItemHeight := 16;
    Style := lbOwnerDrawFixed;
//    OnDblClick := FieldsLBDblClick;
    OnDrawItem := DatasetsLBDrawItem;
    OnStartDrag := FieldsLBStartDrag;
  end;

  FBmp1 := TBitmap.Create;
  FBmp1.LoadFromResourceName(hInstance, 'RM_FLD1');
  FBmp2 := TBitmap.Create;
  FBmp2.LoadFromResourceName(hInstance, 'RM_FLD2');
  FBmp3 := TBitmap.Create;
  FBmp3.LoadFromResourceName(hInstance, 'RM_FLD3');
  FBmp4 := TBitmap.Create;
  FBmp4.LoadFromResourceName(hInstance, 'RM_FLD4');



  Localize;
  Ini := TRegIniFile.Create(RegRootKey);
  DatasetsLB.Height := Ini.ReadInteger(rsForm + ClassName, 'SplitterPos', 120);
  Ini.Free;
  DefHeight := Height;
  if DefHeight < 30 then
    DefHeight := 300;

{$IFDEF USE_TB2k}
  Parent := TWinControl(AOwner);
  Floating := True;
{$ENDIF}
  FullSize := False;
  CloseButtonWhenDocked := True;
  UseLastDock := False;

  SetBounds(372, 202, 400, 327);
  OnVisibleChanged := OnVisibleChangedEvent;
  OnClose := OnFormCloseEvent;
end;

destructor TRMInsFieldsForm.Destroy;
//var
//  Ini: TRegIniFile;
begin
  FBmp1.Free;
  FBmp2.Free;
  FBmp3.Free;
  FBmp4.Free;

//  RMSaveToolWinPosition(Self);
//  Ini := TRegIniFile.Create(RegRootKey);
//  Ini.WriteInteger(rsForm + ClassName, 'SplitterPos', DatasetsLB.Height);
//  Ini.Free;

  inherited Destroy;
end;

procedure TRMInsFieldsForm.FillDatasetsLB;
var
  i: Integer;
  sl: TStringList;
begin
  sl := TStringList.Create;
  DatasetsLB.Items.BeginUpdate;
  CurReport.Dictionary.GetDatasetList(DatasetsLB.Items);
  if CurReport.MixVariablesAndDBFields then
  begin
    CurReport.Dictionary.GetCategoryList(sl);
    for i := 0 to sl.Count - 1 do
      DatasetsLB.Items.AddObject(sl[i], TObject(1));
  end;
  DatasetsLB.Items.EndUpdate;
  sl.Free;

  with DatasetsLB do
  begin
    if Items.Count > 0 then
    begin
      if Items.IndexOf(LastDB) <> -1 then
        ItemIndex := Items.IndexOf(LastDB)
      else
        ItemIndex := 0;
      DatasetsLBClick(nil);
    end
    else
      FieldsLB.Items.Clear;
  end;
end;

procedure TRMInsFieldsForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 450);
end;

procedure TRMInsFieldsForm.DatasetsLBClick(Sender: TObject);
var
  i: Integer;
  sl: TStringList;
begin
  if Integer(DatasetsLB.Items.Objects[DatasetsLB.ItemIndex]) = 1 then
  begin
    sl := TStringList.Create;
    CurReport.Dictionary.GetVariablesList(DatasetsLB.Items[DatasetsLB.ItemIndex], sl);
    FieldsLB.Items.Clear;
    for i := 0 to sl.Count - 1 do
      FieldsLB.Items.AddObject(sl[i], TObject(1));
    sl.Free;
  end
  else
    CurReport.Dictionary.GetFieldList(DatasetsLB.Items[DatasetsLB.ItemIndex], FieldsLB.Items)
end;

procedure TRMInsFieldsForm.GetFieldName;
begin
  if DatasetsLB.Items.Count > 0 then
    LastDB := DatasetsLB.Items[DatasetsLB.ItemIndex];

  if (FieldsLB.ItemIndex <> -1) and (FieldsLB.Items.Count <> 0) then
  begin
    if Integer(FieldsLB.Items.Objects[FieldsLB.ItemIndex]) = 1 then
      DBField := FieldsLB.Items[FieldsLB.ItemIndex]
    else
      DBField := LastDB + '."' + FieldsLB.Items[FieldsLB.ItemIndex] + '"';
  end;
end;

procedure TRMInsFieldsForm.RefreshData;
begin
  if DatasetsLB.Items.Count > 0 then
    LastDB := DatasetsLB.Items[DatasetsLB.ItemIndex];
  FillDatasetsLB;
end;

procedure TRMInsFieldsForm.DatasetsLBDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  bmp: TBitmap;
  r: TRect;
begin
  r := ARect;
  r.Right := r.Left + 18;
  r.Bottom := r.Top + 16;
  OffsetRect(r, 2, 0);
  with TListBox(Control) do
  begin
    Canvas.FillRect(ARect);
    if Control = DatasetsLB then
    begin
      if Integer(Items.Objects[Index]) = 1 then
        bmp := FBmp3
      else
        bmp := FBmp1;
    end
    else if Integer(Items.Objects[Index]) = 1 then
      bmp := FBmp4
    else
      bmp := FBmp2;
    Canvas.BrushCopy(r, bmp, Rect(0, 0, 18, 16),
      bmp.TransparentColor);
    Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
  end;
end;

procedure TRMInsFieldsForm.FieldsLBStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  GetFieldName;
end;

{procedure TRMInsFieldsForm.Grow;
begin
  Height := DefHeight;
  DatasetsLB.Show;
  if Assigned(FHeightChanged) then
    FHeightChanged(Self);
end;}

procedure TRMInsFieldsForm.OnVisibleChangedEvent(Sender: TObject);
begin
  if Visible then
  begin
	  FillDatasetsLB;
  end
  else
  begin
  end;
end;

procedure TRMInsFieldsForm.OnFormCloseEvent(Sender: TObject);
begin
  if Assigned(FOnCloseEvent) then
    FOnCloseEvent(Self);

  GetFieldName;
  if RMDesigner.Visible then
    RMDesigner.SetFocus;
end;

end.