aimctrls.pas

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

      end;
      LB_DELETESTRING:
      begin
       FDeletedIndex := wParam;
       FDeletedSt := FStrings[wParam];
       FStrings.Delete(wParam);
      end;
      else FDeletedIndex := -1;
    end;
  inherited;
end;

function TAutoCustomImageListBox.ValuesIndexOf(Text : String) : Integer;
begin
  for Result := 0 to FStrings.Count - 1 do
    if AnsiCompareText(Text, Values[Result]) = 0 then Exit;
  Result := -1;
end;

{TAutoSpinImageItem}
constructor TAutoSpinImageItem.Create(Collection : TCollection);
begin
  inherited Create(Collection);
  Owner := TAutoSpinImageItems(Collection);
  FImageIndex := -1;
end;

procedure TAutoSpinImageItem.Assign(Source: TPersistent);
begin
  if Source is TAutoSpinImageItem then begin
    ImageIndex := TAutoSpinImageItem(Source).ImageIndex;
    Value := TAutoSpinImageItem(Source).Value;
    Hint := TAutoSpinImageItem(Source).Hint;
  end;
end;

procedure TAutoSpinImageItem.SetImageIndex(Value : Integer);
begin
  if(FImageIndex <> Value) then begin
    FImageIndex := Value;
    if(Owner.Owner <> Nil) then
      Owner.Owner.UpdateItems;
  end;
end;

procedure TAutoSpinImageItem.SetValue(Value : String);
begin
  if(FValue <> Value) then begin
    FValue := Value;
    if(Owner.Owner <> Nil) then
      Owner.Owner.UpdateItems;
  end;
end;

procedure TAutoSpinImageItem.SetHint(Value : String);
begin
  if(FHint <> Value) then
    FHint := Value;
end;


{TAutoSpinImageItems}
constructor TAutoSpinImageItems.Create(AOwner : TAutoCustomSpinImage);
begin
  inherited Create(TAutoSpinImageItem);
  Owner := AOwner;
end;

function TAutoSpinImageItems.Add : TAutoSpinImageItem;
begin
  Result := TAutoSpinImageItem(inherited Add);
end;

function TAutoSpinImageItems.IndexOf(Value : String) : Integer;
begin
  for Result := 0 to Count - 1 do
    if (CompareText(Value, Items[Result].Value) = 0) then
      exit;
  Result := -1;    
end;

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

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

procedure TAutoSpinImageItems.Update(Item: TCollectionItem);
begin
  if(Item <> Nil) And (Owner <> Nil) then
    Owner.UpdateItems;
end;

{TAutoCustomSpinImage}
constructor TAutoCustomSpinImage.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csFramed, csOpaque];

  FUpDown := TUpDown.Create(self);
  with FUpDown do begin
    Parent := self;
    Min := 0;
    Align := alRight;
    Wrap := False;
    ParentShowHint := False;
    OnClick := UpDownClick;
  end;
  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := OnChangeLink;
  FItems := TAutoSpinImageItems.Create(self);

  TabStop := True;
  FBorderStyle := bsSingle;
  FItemIndex := -1;
  FUpDownAlign := udaRight;
  FUpDownWidth := 16;
  FUpDownOrientation := udVertical;
  FImageHAlign := hsiCenter;
  FImageVAlign := vsiCenter;
  FStretch := True;
  FDefaultImages := True;
  Height := 100;
  Width := 118;
  FUseDblClick := True;
end;

destructor TAutoCustomSpinImage.Destroy;
begin
  FItems.Free;
  FUpDown.Free;
  FChangeLink.Free;
  inherited Destroy;
end;

procedure TAutoCustomSpinImage.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_TABSTOP;
  if FBorderStyle = bsSingle then
    Params.Style := Params.Style or WS_BORDER;
end;

procedure TAutoCustomSpinImage.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FImageList <> nil) and
    (AComponent = FImageList) then ImageList := nil;
end;

procedure TAutoCustomSpinImage.SetAutoSize(Value : Boolean);
begin
  if(Value <> FAutoSize) And (FImageList <> Nil) then begin
    FAutoSize := Value;
    if(FAutoSize) then
      MakeAutoSize;
  end;
end;

procedure TAutoCustomSpinImage.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TAutoCustomSpinImage.SetDefaultImages(Value : Boolean);
begin
  if(Value <> FDefaultImages) then begin
    FDefaultImages := Value;
    if Not (csLoading in ComponentState) then begin
      if(Value And (FImageList <> Nil) And (FImageList.Count > 0))
      Or (Not Value And (Items.Count > 0)) then
        ItemIndex := 0
      else ItemIndex := -1;
      UpdateItems;
      Repaint;
    end;
  end;
end;

procedure TAutoCustomSpinImage.SetItemIndex(Value : Integer);
begin
  if (csLoading in ComponentState) then begin
    FItemIndex := Value;
    Change;
    exit;
  end;
  if(Value >= -1) And (FItemIndex <> Value) And (FImageList <> Nil)
  And ((FDefaultImages And (Value < FImageList.Count))
   Or (Not FDefaultImages And (Value < Items.Count)))then begin
    FItemIndex := Value;
    Change;    
    Paint;
  end;
end;

procedure TAutoCustomSpinImage.SetImageList(Value : TImageList);
begin
  if(Value <> FImageList) then begin
    if(FImageList <> Nil) then
      FImageList.UnRegisterChanges(FChangeLink);
    FImageList := Value;
    if(FImageList <> Nil) then
      FImageList.RegisterChanges(FChangeLink);
    if Not (csLoading in ComponentState) then   
      ItemIndex := -1;
    Paint;
  end;
end;

procedure TAutoCustomSpinImage.SetImageHAlign(Value : TAutoHSpinImageAlign);
begin
  if(FImageHAlign <> Value) then begin
    FImageHAlign := Value;
    Repaint;
  end;
end;

procedure TAutoCustomSpinImage.SetImageVAlign(Value : TAutoVSpinImageAlign);
begin
  if(FImageVAlign <> Value) then begin
    FImageVAlign := Value;
    Repaint;
  end;
end;

procedure TAutoCustomSpinImage.SetItems(Value : TAutoSpinImageItems);
begin
  FItems.Assign(Value);
  Update;
  Repaint;
end;

procedure TAutoCustomSpinImage.SetStretch(Value : Boolean);
begin
  if(FStretch <> Value) then begin
    FStretch := Value;
    Repaint;
  end;
end;

procedure TAutoCustomSpinImage.SetUpDownAlign(Value : TAutoUpDownAlign);
begin
  if(Value <> FUpDownAlign) then begin
    FUpDownAlign := Value;
    case Value of
      udaBottom: FUpDown.Align := alBottom;
      udaLeft: FUpDown.Align := alLeft;
      udaRight: FUpDown.Align := alRight;
      udaTop: FUpDown.Align := alTop;
    end;
    SetUpDownWidth(FUpDownWidth);
    Repaint;
  end;
end;

procedure TAutoCustomSpinImage.SetUpDownOrientation(Value : TUDOrientation);
begin
  if(FUpDownOrientation <> Value) then begin
    FUpDownOrientation := Value;
    FUpDown.Orientation := Value;
    SetUpDownWidth(FUpDownWidth);    
  end;
end;

procedure TAutoCustomSpinImage.SetUpDownWidth(Value : Integer);
begin
  if(FUpDownWidth <> Value) then begin
    FUpDownWidth := Value;
    Repaint;
  end;
  FUpDown.Height := Value;
  FUpDown.Width := Value;
  if(FAutoSize) then
    MakeAutoSize;
end;

procedure TAutoCustomSpinImage.CMEnter(var Message: TCMEnter);
begin
  Invalidate;
  inherited;
end;

procedure TAutoCustomSpinImage.CMExit(var Message: TCMExit);
begin
  Invalidate;
  inherited;
end;

procedure TAutoCustomSpinImage.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if TabStop and CanFocus then SetFocus;
  inherited;
end;

procedure TAutoCustomSpinImage.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  if FUseDblClick then
    SetNextItem
  else inherited;
end;


procedure TAutoCustomSpinImage.UpDownClick(Sender: TObject; Button: TUDBtnType);
begin
  if(Not Focused) then
    SetFocus;
  if Not CanChange then exit;
  if(Button = btNext) then
    ItemIndex := FItemIndex + 1
   else
     if(FItemIndex > 0) then
       ItemIndex := FItemIndex - 1;
end;

procedure TAutoCustomSpinImage.MakeAutoSize;
Var
  R : TRect;
  FWidth, FHeight : Integer;
begin
  R := ClientRect;
  FWidth := R.Right - R.Left;
  FHeight := R.Bottom - R.Top;
  case FUpDownAlign of
    udaBottom, udaTop: Dec(FHeight, UpDownWidth);
    udaRight, udaLeft: Dec(FWidth, UpDownWidth);
  end;
  Width := Width + FImageList.Width - FWidth;
  Height := Height + FImageList.Height - FHeight;
end;

procedure TAutoCustomSpinImage.SetNextItem;
begin
  if CanChange And ((FDefaultImages And (FImageList.Count > 0))
  Or(Not FDefaultImages And (Items.Count >0))) then begin
    if( FDefaultImages And (FItemIndex < FImageList.Count - 1))
    Or (Not FDefaultImages And (FItemIndex < Items.Count - 1)) then
      ItemIndex := FItemIndex + 1
    else ItemIndex := 0;
  end;
end;

procedure TAutoCustomSpinImage.OnChangeLink(Sender : TObject);
begin
  if(FDefaultImages) then
    FUpDown.Max := FImageList.Count
  else FUpDown.Max := Items.Count;
  if(FAutoSize) then MakeAutoSize;
  Repaint;
end;


procedure TAutoCustomSpinImage.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  Msg.Result := DLGC_WANTARROWS;
end;

procedure TAutoCustomSpinImage.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if(FImageList <> NIl) And (FImageList.Count > 0) And CanChange then
    case Key of
      VK_UP, VK_HOME:
      begin
        SendMessage(FUpDown.Handle, WM_LBUTTONDOWN, MK_LBUTTON, 1 + $FFFF);      
        if (Key = VK_HOME) And (FImageList <> Nil) then begin
          if(FDefaultImages) then
            ItemIndex := FImageList.Count - 1
          else ItemIndex := Items.Count - 1;
        end;
      end;
      VK_DOWN, VK_END:
      begin
        SendMessage(FUpDown.Handle, WM_LBUTTONDOWN, MK_LBUTTON,
                FUpDown.Width - 1 + $FFFF*(FUpDown.Height - 1));
        if (Key = VK_END) then
          ItemIndex := 0
      end;
      VK_SPACE: SetNextItem;
   end;
   inherited;
end;

procedure TAutoCustomSpinImage.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if(FImageList <> NIl) And (FImageList.Count > 0) then
    case Key of
      VK_UP, VK_HOME:
        SendMessage(FUpDown.Handle, WM_LBUTTONUP, MK_LBUTTON, 1);
      VK_DOWN, VK_END:
        SendMessage(FUpDown.Handle, WM_LBUTTONUP, MK_LBUTTON,
                                    FUpDown.Width - 1 + $FFFF*(FUpDown.Height - 1));
   end;
   inherited;
end;


procedure TAutoCustomSpinImage.Paint;
var
  Image : TBitmap;
  R: TRect;
  FLeft, FTop : Integer;
begin
  with Canvas do  begin
    Brush.Style := bsSolid;
    Brush.Color := Color;
    R := ClientRect;
    case FUpDownAlign of
      udaBottom: Dec(R.Bottom, UpDownWidth);
      udaLeft: Inc(R.Left, UpDownWidth);
      udaRight: Dec(R.Right, UpDownWidth);
      udaTop: Inc(R.Top, UpDownWidth);
    end;
    if (FImageList <> Nil) And (FItemIndex <> -1) then  begin