aimctrls.pas

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

      Image := TBitmap.Create;
      if FDefaultImages then
        FImageList.GetBitmap(ItemIndex, Image)
      else FImageList.GetBitmap(Items[ItemIndex].ImageIndex, Image);
      if(FStretch) then
        StretchDraw(r, Image)
      else begin
        FillRect(R);
        FLeft := R.Left;
        FTop := R.Top;
        if(R.Right - R.Left > FImageList.Width) then
          case FImageHAlign of
            hsiCenter: Inc(FLeft, (R.Right - R.Left - FImageList.Width) div 2);
            hsiRight: Inc(FLeft, R.Right - R.Left - FImageList.Width);
          end;
        if(R.Bottom - R.Top > FImageList.Height) then
          case FImageVAlign of
            vsiCenter: Inc(FTop, (R.Bottom - R.Top - FImageList.Height) div 2);
            vsiBottom: Inc(FTop, R.Bottom - R.Top - FImageList.Height);
          end;
        Draw(FLeft, FTop, Image);
      end;
      Image.Free;
    end
    else begin
      FillRect(R);
    end;
    if (GetParentForm(Self).ActiveControl = Self) and
      not (csDesigning in ComponentState) then  begin
      Brush.Color := clWindowFrame;
      FrameRect(R);
    end;
  end;
end;

function TAutoCustomSpinImage.CanChange : Boolean;
begin
  Result := Not FReadOnly;
end;

procedure TAutoCustomSpinImage.Change;
begin
  if Not FDefaultImages And (FItemIndex > -1)
  And Not (csDesigning in ComponentState) then begin
    Hint := Items[FItemIndex].Hint;
    if(Hint <> '') then
      ShowHint := True
    else ShowHint := False;
  end;
  if Not (csLoading in ComponentState) then begin
    if(FDefaultImages) then
      FUpDown.Max := FImageList.Count
    else FUpDown.Max := Items.Count;
    FUpDown.Position := FItemIndex;
  end;  
  if Assigned(FOnChange) then
    FOnChange(self, FItemIndex);
end;

procedure TAutoCustomSpinImage.UpdateItems;
begin

end;

{TAutoImageComboBox}
constructor TAutoImageComboBox.Create(AOwner : TComponent);
begin
  inherited;
  FStrings := TStringList.Create;
  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := OnChangeLink;


  Style := csOwnerDrawFixed;
  FItemHeight := 0;
  FVertAlignment := tvaCenter;
end;

destructor TAutoImageComboBox.Destroy;
begin
  FChangeLink.Free;
  FStrings.Free;
  inherited;
end;

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

procedure TAutoImageComboBox.Assign(Source: TPersistent);
Var
  lb : TAutoImageComboBox;
  lb1 : TAutoCustomImageListBox;
begin
  if(Source is TAutoImageComboBox)
  Or(Source is TAutoCustomImageListBox) then begin
    if(Source is TAutoImageComboBox) then begin
      lb := TAutoImageComboBox(Source);
      FImageList := lb.FImageList;
      Items.Assign(lb.Items);
      FStrings.Assign(lb.FStrings);
      FImageAlign := lb.FImageAlign;
      FAlignment := lb.FAlignment;
      MultiLines := lb.MultiLines;
      FVertAlignment := lb.FVertAlignment;
      Font := lb.Font;
    end;
    if(Source is TAutoCustomImageListBox) then begin
      lb1 := TAutoCustomImageListBox(Source);
      FImageList := lb1.FImageList;
      Items.Assign(lb1.Items);
      FStrings.Assign(lb1.FStrings);
      FImageAlign := lb1.FImageAlign;
      FAlignment := lb1.FAlignment;
      MultiLines := lb1.MultiLines;
      FVertAlignment := lb1.FVertAlignment;
      Font := lb1.Font;
    end;
    SetInheritedItemHeight;
  end
  else inherited;
end;

function TAutoImageComboBox.GetImageIndex(Index : Integer) : Integer;
Var
  St : String;
begin
  Result := -1;
  if(Index < FStrings.Count) then begin
    St := FStrings[Index];
    if(Pos(',', St) > 0) then begin
      St := Copy(St, 1, Pos(',', St) - 1);
      if(St <> '') then
        Result := StrToInt(St);
    end;    
  end;
end;

function TAutoImageComboBox.GetValue(INdex : Integer) : String;
begin
  Result := '';
  if(Index < FStrings.Count) And (Pos(',', FStrings[Index]) > 0) then
    Result := Copy(FStrings[Index], Pos(',', FStrings[Index]) + 1, 1000);
end;

procedure TAutoImageComboBox.SetImageIndex(Index : Integer; Value : Integer);
Var
  St : String;
begin
  if(Index < FStrings.Count)
  And (Value <> ImageIndexes[Index])then begin
    St := Values[Index];
    FStrings[Index] := IntToStr(Value) + ',' + St;
  end;
end;

procedure TAutoImageComboBox.SetAlignment(Value : TAlignment);
begin
  if(Value <> FAlignment) then
    FAlignment := Value;
end;

procedure TAutoImageComboBox.SetVertAlignment(Value : TVertAlignment);
begin
  if(Value <> FVertAlignment) then
    FVertAlignment := Value;
end;

procedure TAutoImageComboBox.SetImageAlign(Value : TAutoImageAlign);
begin
  if(Value <> FImageAlign) then
    FImageAlign := Value;
end;

procedure TAutoImageComboBox.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);
    SetInheritedItemHeight;
  end;
end;

procedure TAutoImageComboBox.SetItemHeight(Value : Integer);
begin
  if(Value <> FItemHeight) then begin
    if(Value < 10) then
      FItemHeight := 0
    else FItemHeight := Value;
    SetInheritedItemHeight;
  end;
end;

procedure TAutoImageComboBox.SetMultiLines(Value : Boolean);
begin
  if(Value <> FMultiLines) then 
    FMultiLines := Value;
end;

procedure TAutoImageComboBox.SetValue(Index : Integer; const Value : String);
Var
  St : String;
begin
  if(Index < FStrings.Count) And (Index > -1)
  And (Value <> Values[Index])then begin
    St := IntToStr(ImageIndexes[Index]);
    FStrings[Index] := St + ',' + Value;
  end;
end;

procedure TAutoImageComboBox.AddItem(St :String; ImageIndex : Integer);
begin
  Items.Add(St);
  SetImageIndex(Items.Count -1, ImageIndex);
end;

procedure TAutoImageComboBox.InsertItem(Index : Integer;
          St :String; ImageIndex : Integer);
begin
  if(Index < 0) then Index := 0;
  if(Index >= Items.Count) then
    AddItem(St, ImageIndex)
  else begin
    Items.Insert(Index, St);
    SetImageIndex(Index, ImageIndex);
  end;
end;

procedure TAutoImageComboBox.ExchangeItems(Index1, Index2 : Integer);
var
  flag : Boolean;
  St1, St2 : string;
begin
  flag := (Index1 > -1 ) And (Index1 < Items.Count)
           And (Index2 > -1 ) And (Index2 < Items.Count);
  if(flag) then begin
    St1 := FStrings[Index1];
    St2 := FStrings[Index2];
  end;
  Items.Exchange(Index1, Index2);
  if(flag) then begin
    FStrings[Index1] := St2;
    FStrings[Index2] := St1;
  end;
end;

procedure TAutoImageComboBox.MoveItem(CurIndex, NewIndex: Integer);
Var
  TempString: string;
begin
  if (CurIndex <> NewIndex) And (CurIndex > -1) And (CurIndex < Items.Count) then begin
    TempString := FStrings[CurIndex];
    Items.Move(CurIndex, NewIndex);
    FStrings[NewIndex] := TempString;
  end;
end;

procedure TAutoImageComboBox.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('SaveStrings', StringsRead, StringsWrite, True); 
end;

procedure TAutoImageComboBox.StringsRead(Reader: TReader);
begin
  Reader.ReadListBegin;
  FStrings.Clear;
  while not Reader.EndOfList do
    FStrings.Add(Reader.ReadString);
  Reader.ReadListEnd;
end;

procedure TAutoImageComboBox.StringsWrite(Writer: TWriter);
var
  i: Integer;
begin
  Writer.WriteListBegin;
  for i := 0 to FStrings.Count - 1 do
    Writer.WriteString(FStrings[I]);
  Writer.WriteListEnd;
end;

procedure TAutoImageComboBox.DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState);
const
  AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_EXPANDTABS or DT_NOPREFIX  Or DT_EDITCONTROL,
      DT_RIGHT or DT_EXPANDTABS  or DT_NOPREFIX Or DT_EDITCONTROL,
      DT_CENTER or DT_EXPANDTABS or DT_NOPREFIX Or DT_EDITCONTROL);
  VAlignFlags : array [TVertAlignment] of Integer =
      (DT_TOP or DT_SINGLELINE,
       DT_VCENTER or DT_SINGLELINE,
       DT_BOTTOM or DT_SINGLELINE);
Var
  r : TRect;
  Image: TBitmap;
  ImageFlag : Boolean;
  Drawflag, ImageWidth : Integer;
begin
  with Canvas do  begin
    FillRect(Rect);
    ImageFlag := (FImageList <> Nil) And (ImageIndexes[Index] > -1)
                  And (ImageIndexes[Index] < FImageList.Count);
    if (FImageList <> Nil) then begin
      r.Top := Rect.Top + 1;
      r.Bottom := Rect.Bottom - 1;
      ImageWidth := ((r.Bottom - r.Top) * FImageList.Width) div FImageList.Height;
      if (FImageAlign = aliLeft) then begin
        r.Left := Rect.Left - 1 ;
        r.Right := Rect.Left + ImageWidth + 2;
      end else begin
        r.Left := Rect.Right - 2 - ImageWidth;
        r.Right := Rect.Right - 1;
      end;
    end;
    if ImageFlag then begin
      if (Index = ItemIndex) And (Canvas.Brush.Color <> Color)then
        DrawEdge(Canvas.handle, r, EDGE_RAISED, BF_RECT);
      Inc(r.Top);
      Inc(r.Left);
      Dec(r.Bottom);
      Dec(r.Right);
      Image := TBitmap.Create;
      FImageList.GetBitmap(GetImageIndex(Index), Image);
      StretchDraw(r, Image);
      Image.Free;
    end;
    Inc(Rect.Top);
    Dec(Rect.Bottom);
    if (FImageList <> Nil) then begin
      if(FImageAlign = aliLeft) then
        Rect.Left := r.Right
      else Rect.Right := r.Left;
    end;
    Inc(Rect.Left);
    Dec(Rect.Right);
    SetBkMode(Handle, TRANSPARENT);
    if(Assigned(FOnDrawItem)) then begin
      FOnDrawItem(self, Index, Rect);
    end else begin
      if(FMultiLines) then
        DrawFlag := AlignFlags[Alignment] Or (DT_WORDBREAK)
      else DrawFlag := AlignFlags[Alignment] Or VAlignFlags[VertAlignment];
      DrawText(Handle, PChar(Items[Index]), Length(Items[Index]), Rect, DrawFlag);
    end;
  end;
end;


procedure TAutoImageComboBox.SetInheritedItemHeight;
Var
  h : Integer;
begin
  if(FItemHeight < 10) then begin
    h := Font.Height;
    if(FImageList <> NIl) And (h < FImageList.Height) then
      h := FImageList.Height;
    Inc(h, 2);
  end else h := FItemHeight;
  if(h <> inherited ItemHeight) then
    inherited ItemHeight := h;
  RecreateWnd;
end;

procedure TAutoImageComboBox.OnChangeLink(Sender : TObject);
begin
  SetInheritedItemHeight;
end;

procedure TAutoImageComboBox.CMFontChanged(var Message: TMessage);
begin
  inherited;
  SetInheritedItemHeight;
end;

procedure TAutoImageComboBox.WndProc(var Message : TMessage);
begin
  with Message do
    case Msg of
      CB_INSERTSTRING:
      begin
        if (FDeletedIndex = wParam) And (wParam <> -1) then
          FStrings.Insert(wParam, FDeletedSt)
        else begin
          FStrings.Insert(wParam, '');
          ImageIndexes[wParam] := -1;
        end;  
      end;
      CB_ADDSTRING:
      begin
        FStrings.Add('');
        ImageIndexes[FStrings.Count - 1] := -1;
      end;
      CB_DELETESTRING:
      begin
       FDeletedIndex := wParam;
       FDeletedSt := FStrings[wParam];
       FStrings.Delete(wParam);
      end;
      else FDeletedIndex := -1;
    end;
  inherited;
end;

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

end.