aoutlbar.pas

来自「delphi编程控件」· PAS 代码 · 共 2,084 行 · 第 1/5 页

  if(FCaption <> Value) then begin
    FCaption := Value;
    if(FStoredItem <> Nil) And (FCaption <> FStoredItem.Caption) then
      IsDefault := False;
    if (Collection <> Nil)  then begin
      ABar := TAutoOutLookItems(Collection).AutoOutLookBar;
      if(ABar <> Nil) And (ABar.ActiveGroup <> Nil)
      And (ABar.ActiveGroup = TAutoOutLookItems(Collection).Group) then
        TAutoOutLookItems(Collection).AutoOutLookBar.DrawItems;
    end;
  end;
end;

procedure TAutoOutLookItem.SetHint(Value : String);
begin
  if(FHint <> Value) then begin
    FHint := Value;
    if(FStoredItem <> Nil) And (FHint <> FStoredItem.Hint) then
      IsDefault := False;
  end;
end;

procedure TAutoOutLookItem.SetIsDefault(Value : Boolean);
begin
  FIsDefault := Value;
  if(FStoredItem <> Nil) And (Value) then begin
    Caption := FStoredItem.Caption;
    Hint := FStoredItem.Hint;
    LargeImage := FStoredItem.LargeImage;
    SmallImage := FStoredItem.SmallImage;
  end;
end;

procedure TAutoOutLookItem.SetLargeImage(Value : Integer);
begin
  if(FLargeImage <> Value) then begin
    FLargeImage := Value;
    if(FStoredItem <> Nil) And (FLargeImage <> FStoredItem.LargeImage) then
      IsDefault := False;
    if (Collection <> Nil) And
    (TAutoOutLookItems(Collection).AutoOutLookBar.ActiveGroup =
    TAutoOutLookItems(Collection).Group) then
      TAutoOutLookItems(Collection).AutoOutLookBar.DrawItems;
  end;
end;

procedure TAutoOutLookItem.SetSmallImage(Value : Integer);
begin
  if(FSmallImage <> Value) then begin
    FSmallImage := Value;
    if(FStoredItem <> Nil) And (FSmallImage <> FStoredItem.SmallImage) then
      IsDefault := False;
    if (Collection <> Nil) And
    (TAutoOutLookItems(Collection).AutoOutLookBar.ActiveGroup =
    TAutoOutLookItems(Collection).Group) then
      TAutoOutLookItems(Collection).AutoOutLookBar.DrawItems;
  end;
end;

procedure TAutoOutLookItem.SetStoredItem(Value : TAutoOutLookStoredItem);
begin
  if(Value = Nil) then
    self.Free
  else
    if(Value <> FStoredItem) then begin
      FStoredItem := Value;
      if (FStoredItem <> Nil) And (Collection <> Nil)
      And Not (csLoading in TAutoOutLookItems(Collection).AutoOutLookBar.ComponentState) then begin
        FCaption := FStoredItem.Caption;
        FSmallImage := FStoredItem.SmallImage;
        FLargeImage := FStoredItem.LargeImage;        
        FIsDefault := True;
        TAutoOutLookItems(Collection).AutoOutLookBar.Repaint;
      end;
    end;
end;

{TAutoOutLookItems}
constructor TAutoOutLookItems.Create(AOwner : TAutoOutLookGroup);
begin
  inherited Create(TAutoOutLookItem);
  Group := AOwner;
  AutoOutLookBar := TAutoOutLookGroups(Group.Collection).AutoOutLookBar;
end;

procedure TAutoOutLookItems.Update(Item: TCollectionItem); 
begin
  if (AutoOutLookBar <> Nil) And (AutoOutLookBar.Owner <> Nil)
  And Not (csLoading in AutoOutLookBar.Owner.ComponentState)
  And (AutoOutLookBar.ActiveGroup = Group) then
    AutoOutLookBar.DrawItems;
end;

function TAutoOutLookItems.Add : TAutoOutLookItem;
begin
  Result := TAutoOutLookItem(inherited Add);
end;

function TAutoOutLookItems.GetItem(Index : Integer) : TAutoOutLookItem;
begin
  Result := TAutoOutLookItem(inherited Items[Index]);
end;

procedure TAutoOutLookItems.SetItem(Index : Integer; Value : TAutoOutLookItem);
begin
  Items[Index].Assign(Value);
end;


{TAutoOutLookGroup}
constructor TAutoOutLookGroup.Create(Collection : TCollection);
begin
  inherited Create(Collection);
  FItems := TAutoOutLookItems.Create(self);
  FCaption := LoadStr(AS_OLB_DEFAULTGROUPCAPTION);
  FTopVisibleItem := 0;
  FIconType := aotLargeIcon;
  FIsAssigning := False;
  if(TAutoOutLookGroups(Collection).AutoOutLookBar.FActiveGroup = Nil)
  And Not (csLoading in TAutoOutLookGroups(Collection).AutoOutLookBar.ComponentState)then
    TAutoOutLookGroups(Collection).AutoOutLookBar.ActiveGroup := self;
end;

destructor TAutoOutLookGroup.Destroy;
Var
  Bar : TAutoOutLookBar;
begin
  Bar := TAutoOutLookGroups(Collection).AutoOutLookBar;
  if(Bar <> Nil) And (Bar.ComponentState = []) And (Bar.IsEditing) then
    Bar.EndEdit(False);
  if Not (Active) then
    Bar := NIl;
  FItems.Free;
  inherited Destroy;
  if(Bar <> Nil) And (Bar.ComponentState = []) then
    Bar.ActiveGroup := NIl;
end;

procedure TAutoOutLookGroup.MakeActive;
begin
  TAutoOutLookGroups(Collection).AutoOutLookBar.ActiveGroup := self;
end;

function TAutoOutLookGroup.GetActive : Boolean;
begin
  Result := TAutoOutLookGroups(Collection).AutoOutLookBar.ActiveGroup = self;
end;

function TAutoOutLookGroup.GetItemCount : Integer;
begin
  Result := FItems.Count;
end;

function TAutoOutLookGroup.GetVisibleCount : Integer;
Var
  i : Integer;
begin
  Result := 0;
  if(Active) And (FTopVisibleItem > -1) And (Items.Count > 0) then begin
    i := FTopVisibleItem;
    while (i < Items.Count) And Items[i].Visible do begin
      Inc(i);
      Inc(Result);
    end;
  end;
end;

procedure TAutoOutLookGroup.SetCaption(Value : String);
Var
  Bar : TAutoOutLookBar;
  SFont : TFont;
begin
  if(FCaption <> Value) then begin
    FCaption := Value;
    if FIsAssigning then exit;
    Bar := TAutoOutLookGroups(Collection).AutoOutLookBar;
    if (Bar <> Nil) And
    Not ((csLoading in Bar.ComponentState) Or (csDestroying in Bar.ComponentState))then begin
      if Assigned(Bar.OnChangeGroupCaption) then
        Bar.OnChangeGroupCaption(self, self);
        // ReAssign CanvasDC and Font !!! 
        Bar.FCanvasDC := Bar.Canvas.Handle;
        SFont := Bar.Canvas.Font;
        Bar.Canvas.Font := Bar.GroupFont;
        Bar.DrawGroup(Index);
        Bar.Canvas.Font := SFont;
    end;
  end;
end;

procedure TAutoOutLookGroup.SetIconType(Value : TAutoOutLookGroupIconType);
Var
  ABar : TAutoOutLookBar;
begin
  if(FIconType <> Value) then begin
    FIconType := Value;
    if(TopVisibleItem <> 0) then
      TopVisibleItem := 0;
    if FIsAssigning then exit;
    ABar := TAutoOutLookGroups(Collection).AutoOutLookBar;
    if (ABar <> Nil) And
    Not (csLoading in ABar.ComponentState)
    And (self = ABar.ActiveGroup)then
      ABar.DrawItems;
  end;
end;

procedure TAutoOutLookGroup.SetItems(Value : TAutoOutLookItems);
begin
  FTopVisibleItem := 0;
  FItems.Assign(Value);
  if (FItems.Count > 0) then
    FTopVisibleItem := 0;
end;

procedure TAutoOutLookGroup.SetTopVisibleItem(Value : Integer);
Var
  Bar : TAutoOutLookBar;
begin
  if(FTopVisibleItem <> Value)
  And (Value > -1) And (Value < Items.Count)then begin
    FTopVisibleItem := Value;
    Bar := TAutoOutLookGroups(Collection).AutoOutLookBar;
    if (Bar <> Nil) And
    Not (csLoading in Bar.ComponentState)
    And (Bar.ActiveGroup = self)then
     Bar.DrawItems;
  end;
end;

procedure TAutoOutLookGroup.Assign(Source: TPersistent);
begin
  if(Source is TAutoOutLookGroup) then begin
    FIsAssigning := True;
    Caption := TAutoOutLookGroup(Source).Caption;
    IconType := TAutoOutLookGroup(Source).IconType;
    SetItems(TAutoOutLookGroup(Source).Items);
    FIsAssigning := False;
  end
  else inherited Assign(Source);  
end;


{TAutoOutLookGroups}
constructor TAutoOutLookGroups.Create(AOwner : TAutoOutLookBar);
begin
  inherited Create(TAutoOutLookGroup);
  AutoOutLookBar := AOwner;
end;

function TAutoOutLookGroups.Add : TAutoOutLookGroup;
begin
  Result := TAutoOutLookGroup(inherited Add);
end;

function TAutoOutLookGroups.GetItem(Index : Integer) : TAutoOutLookGroup;
begin
  Result := TAutoOutLookGroup(inherited Items[Index]);
end;

procedure TAutoOutLookGroups.SetItem(Index : Integer; Value : TAutoOutLookGroup);
begin
  Items[Index].Assign(Value);
end;

procedure TAutoOutLookGroups.Update(Item: TCollectionItem);
begin
  if(AutoOutLookBar <> Nil) And (AutoOutLookBar.Owner <> Nil)
  And Not (csLoading in AutoOutLookBar.Owner.ComponentState)
  And Not (csDestroying in AutoOutLookBar.ComponentState)
  And (Count > 0) then begin
    if(AutoOutLookBar.FActiveGroup = Nil)  then
      AutoOutLookBar.ActiveGroup := Items[0]
    else AutoOutLookBar.Repaint;
  end;
end;


{TAutoOutLookBarBackGround}
constructor TAutoOutLookBarBackGround.Create;
begin
  inherited Create;
  FBeginColor := clGray;
  FEndColor := clGray;
  FFillStyle := bfsNone;
end;

function TAutoOutLookBarBackGround.IsUsed : Boolean;
begin
  Result := (FFillStyle <> bfsNone) And (FBeginColor <> EndColor);
end;

procedure TAutoOutLookBarBackGround.SetBeginColor(Value : TColor);
begin
  if(FBeginColor <> Value) then begin
    FBeginColor := Value;
    DoChange;
  end;
end;

procedure TAutoOutLookBarBackGround.SetEndColor(Value : TColor);
begin
  if(FEndColor <> Value) then begin
    FEndColor := Value;
    DoChange;
  end;
end;

procedure TAutoOutLookBarBackGround.SetFillStyle(Value : TAutoOutLookBarFillStyle);
begin
  if(FFillStyle <> Value) then begin
    FFillStyle := Value;
    DoChange;
  end;
end;

procedure TAutoOutLookBarBackGround.DoChange;
begin
  if Assigned(FOnChange) then
    FOnChange(self);
end;

{TAutoOutlookBarRenameEdit}
type
TAutoOutlookBarRenameEdit = class(TEdit)
private
  procedure WMKeyDown(Var Message : TMessage); message WM_KEYDOWN;
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure KeyPress(var Key: Char); override;
end;

procedure TAutoOutlookBarRenameEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_BORDER;
  if(TAutoOutlookBar(Owner).FRenameItem <> Nil) then begin
    if (TAutoOutlookBar(Owner).ActiveGroup.IconType = aotLargeIcon) then
      Params.Style := Params.Style or   ES_MULTILINE or ES_CENTER or ES_AUTOHSCROLL
    else Params.Style := Params.Style or ES_LEFT or ES_AUTOHSCROLL;
  end;
end;

procedure TAutoOutlookBarRenameEdit.KeyPress(var Key: Char);
var
  r : TRect;
  St : String;
begin
  inherited KeyPress(Key);
  if(TAutoOutlookBar(Owner).FRenameItem <> Nil) then begin
    if(TAutoOutlookBar(Owner).ActiveGroup.IconType = aotLargeIcon) then
      St := Text + Key
    else St := '';  
    r:= TAutoOutlookBar(Owner).GetItemTextRect(TAutoOutlookBar(Owner).FRenameItem.Index, St);
    if(Left <> r.Left) Or (Width <> r.Right - r.Left)
    Or (Height <> r.Bottom - r.Top) Or (Top <> r.Top) then begin
      Top := r.Top;
      Left := r.Left;
      Width := r.Right - r.Left;
      Height := r.Bottom - r.Top;
    end;
  end;
end;

procedure TAutoOutlookBarRenameEdit.WMKeyDown(Var Message : TMessage);
begin
  if(Message.wparam = VK_RETURN) Or (Message.wparam = VK_ESCAPE) then begin
     TAutoOutlookBar(Owner).EndEdit(Message.wparam = VK_RETURN);
     exit;
  end;
  inherited;
end;

procedure ScrollButtonsTimerProc(Wnd: HWnd; Msg, TimerID, SysTime: Longint); stdcall;
Var
  Bar : TAutoOutLookBar;
begin
  Bar := TAutoOutLookBar(FindControl(wnd));
  if Bar = Nil then exit;
  if Bar.FScrollButtonUpIsDown or Bar.FScrollButtonDownIsDown then begin
   Bar.FDestDropItemIndex := Nil;
   Bar.FIsDropBottom := True;
   if Bar.FScrollButtonUpIsDown then
      Bar.ActiveGroup.TopVisibleItem:= Bar.ActiveGroup.TopVisibleItem - 1;
    if Bar.FScrollButtonDownIsDown then
     Bar.ActiveGroup.TopVisibleItem:= Bar.ActiveGroup.TopVisibleItem + 1;
  end else begin //!!! Kill itself !!!
    KillTimer(Bar.Handle, Bar.FScrollTimerID);
    Bar.FScrollTimerID := -1;
  end;
end;

procedure HintTimerProc(Wnd: HWnd; Msg, TimerID, SysTime: Longint); stdcall;
Var
  Bar : TAutoOutLookBar;
begin
  Bar := TAutoOutLookBar(FindControl(wnd));
  if Bar = Nil then exit;
  Bar.HintActivate(False);
  KillTimer(Bar.Handle, Bar.FHintTimerID);
  Bar.FHintTimerID := -1;
end;


{TAutoOutLookBar}
constructor TAutoOutLookBar.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls]
               + [csDesignInteractive];
  FGroups := TAutoOutLookGroups.Create(self);
  FGroupFont := TFont.Create;
  FItemFont := TFont.Create;
  FImageList := TImageList.Create(self);
  FItemFont.Color := clWhite;
  FBkPicture := TPicture.Create;
  FBkPicture.OnChange := DoBkPictureChange;