dxbaraddgroupitemsed.pas

胜天进销存源码,国产优秀的进销存

{*******************************************************************}
{                                                                   }
{       Developer Express Visual Component Library                  }
{       ExpressBars choose group item form                          }
{                                                                   }
{       Copyright (c) 1998-2008 Developer Express Inc.              }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS   }
{   LICENSED TO DISTRIBUTE THE EXPRESSBARS AND ALL ACCOMPANYING VCL }
{   CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY.                 }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT  }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                      }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit dxBarAddGroupItemsEd;

{$I cxVer.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, StdCtrls, dxCommon, dxBar, cxGraphics;

type
  TfrmAddGroupItems = class(TForm)
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    lbGroupItems: TListBox;
    Panel1: TPanel;
    Panel5: TPanel;
    btnOk: TButton;
    btnCancel: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure lbGroupItemsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lbGroupItemsMeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
  private
    FGroup: TdxBarGroup;
    PrevListBoxWndProc: TWndMethod;
    procedure SetGroup(Value: TdxBarGroup);
    procedure ListBoxWndProc(var Message: TMessage);
  public
    GroupItems: TList;
    property Group: TdxBarGroup read FGroup write SetGroup;
  end;

function dxBarChooseGroupItem(AGroup: TdxBarGroup; AGroupItems: TList): Boolean;

implementation

{$R *.DFM}

function dxBarChooseGroupItem(AGroup: TdxBarGroup; AGroupItems: TList): Boolean;
begin
  with TfrmAddGroupItems.Create(nil) do
    try
      Group := AGroup;
      GroupItems := AGroupItems;
      Result := ShowModal = mrOk;
    finally
      Free;
    end;
end;

procedure TfrmAddGroupItems.FormCreate(Sender: TObject);
begin
  with lbGroupItems do
  begin
    SetClassLong(Handle, GCL_STYLE, GetClassLong(Handle, GCL_STYLE) or CS_HREDRAW);
    PrevListBoxWndProc := WindowProc;
    WindowProc := ListBoxWndProc;
  end;
end;

procedure TfrmAddGroupItems.FormDestroy(Sender: TObject);
begin
  with lbGroupItems do
    WindowProc := PrevListBoxWndProc;
end;

procedure TfrmAddGroupItems.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  I: Integer;
begin
  if ModalResult = mrOK then
    with lbGroupItems, Items do
      for I := 0 to Count - 1 do
        if Selected[I] then
          GroupItems.Add(Objects[I]);
end;

procedure TfrmAddGroupItems.lbGroupItemsDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  S: string;
  Item: TdxBarComponent;
  R: TRect;
  LineColor: COLORREF;
begin
  with TListBox(Control), Canvas do
  begin
    S := Items[Index];
    if (Length(S) <> 0) and (S[1] = '~') then
    begin
      Delete(S, 1, 1);
      Font.Color := clBtnText;
      Brush.Color := clBtnFace;
      with Rect do
        cxExtTextOut(Handle, S, Point(Left + 2, Top + 1), Rect, ETO_OPAQUE);
    end
    else
    begin
      Item := TdxBarComponent(Items.Objects[Index]);
      S := '   ' + S;
      R := Rect;
      if Item is TdxBarItem then
        with R do
          Right := (Left + Right) div 2 - 1;
      if Group.IndexOf(Item) <> -1 then
      begin
        Font.Color := clBtnFace;
        Brush.Color := clWindow;
      end;
      FillRect(R);
      SetBkMode(Handle, TRANSPARENT);
      cxDrawText(Handle, S, R, DT_SINGLELINE or DT_VCENTER);
      SetBkMode(Handle, OPAQUE);

      if Item is TdxBarItem then
      begin
        R.Left := R.Right;
        Inc(R.Right);
        if Brush.Color = clHighlight then
          LineColor := COLOR_HIGHLIGHTTEXT
        else
          LineColor := COLOR_WINDOWTEXT;
        Windows.FillRect(Handle, R, LineColor + 1);

        R.Left := R.Right;
        R.Right := Rect.Right;
        S := Item.Name;
        with R do
          cxExtTextOut(Handle, S, Point(Left + 2, Top + 1), R, ETO_OPAQUE);
      end;
    end;
    if Index = Items.Count - 1 then
    begin
      Rect.Top := Rect.Bottom;
      Rect.Bottom := ClientHeight;
      Windows.FillRect(Handle, Rect, COLOR_BTNFACE + 1);
    end;
  end;
end;

procedure TfrmAddGroupItems.lbGroupItemsMeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
begin
  with TListBox(Control) do
    Canvas.Font := Font;
  Height := TListBox(Control).Canvas.TextHeight('Qq') + 2;
end;

procedure TfrmAddGroupItems.SetGroup(Value: TdxBarGroup);
var
  List: TList;
  I, J: Integer;
begin
  FGroup := Value;
  Font := FGroup.BarManager.Font;
  with lbGroupItems.Items do
  begin
    List := TList.Create;
    BeginUpdate;
    try
      if Group.BarManager.GroupCount > 1 then
      begin
        Add('~< Groups >');
        with Group.BarManager do
          for I := 0 to GroupCount - 1 do
            if Groups[I] <> Group then
              AddObject(Groups[I].Name, Groups[I]);
      end;
      for I := 0 to Group.BarManager.Categories.Count - 1 do
      begin
        J := Group.BarManager.GetItemsByCategory(I, List);
        if J <> 0 then
        begin
          Add('~' + Group.BarManager.Categories[I]);
          for J := 0 to J - 1 do
            with TdxBarItem(List[J]) do
              AddObject(Caption, List[J]);
        end;
      end;
    finally
      EndUpdate;
      List.Free;
    end;
  end;
end;

procedure TfrmAddGroupItems.ListBoxWndProc(var Message: TMessage);
begin
  with Message do
    if Msg = WM_ERASEBKGND then
    begin
      Result := 1;
      Exit;
    end;
  PrevListBoxWndProc(Message);
end;

end.