aimctrls.pas

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

  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;
      ItemHeight := lb.ItemHeight;
      FVertAlignment := lb.FVertAlignment;
      Font := lb.Font;
    end;
    if(Source is TAutoCustomImageListBox) then begin
      lb1 := TAutoCustomImageListBox(Source);
      FImageList := lb1.FImageList;
      IntegralHeight := lb1.IntegralHeight;
      ItemHeight := lb1.ItemHeight;
      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;
    Repaint;
  end
  else inherited;
end;

function TAutoCustomImageListBox.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 TAutoCustomImageListBox.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 TAutoCustomImageListBox.SetImageIndex(Index : Integer; Value : Integer);
Var
  St : String;
begin
  if(Index < FStrings.Count) And (Index > -1)
  And (Value <> ImageIndexes[Index])then begin
    St := Values[Index];
    FStrings[Index] := IntToStr(Value) + ',' + St;
    if(HandleAllocated) then Repaint;
  end;
end;

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

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

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

procedure TAutoCustomImageListBox.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 TAutoCustomImageListBox.SetItemHeight(Value : Integer);
begin
  if(Value <> FItemHeight) then begin
    if(Value < 10) then
      FItemHeight := 0
    else FItemHeight := Value;
    SetInheritedItemHeight;
  end;
end;

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

procedure TAutoCustomImageListBox.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 TAutoCustomImageListBox.AddItem(St :String; ImageIndex : Integer);
begin
  Items.Add(St);
  SetImageIndex(Items.Count -1, ImageIndex);
end;

procedure TAutoCustomImageListBox.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 TAutoCustomImageListBox.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 TAutoCustomImageListBox.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 TAutoCustomImageListBox.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('SaveStrings', StringsRead, StringsWrite, True); 
end;

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

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

function TAutoCustomImageListBox.GetImageRect(ItemIndex : Integer) : TRect;
Var
  ImageWidth : Integer;
  r : TRect;
begin
  r := ItemRect(ItemIndex);
  if (FImageList <> Nil) then begin
    Result.Top := r.Top + 1;
    Result.Bottom := r.Bottom - 1;
    ImageWidth := ((Result.Bottom - Result.Top) * FImageList.Width) div FImageList.Height;
    if (FImageAlign = aliLeft) then begin
       Result.Left := r.Left + 1 ;
       Result.Right := r.Left + ImageWidth + 2;
    end else begin
      Result.Left := r.Right - 2 - ImageWidth;
      Result.Right := r.Right - 1;
    end;
  end;
end;

procedure TAutoCustomImageListBox.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, r1 : TRect;
  Image: TBitmap;
  ImageFlag : Boolean;
  Drawflag : Integer;
begin
  with Canvas do  begin
    ImageFlag := (FImageList <> Nil) And (ImageIndexes[Index] > -1)
                  And (ImageIndexes[Index] < FImageList.Count);
    r := GetImageRect(Index);
    r1 := Rect;
    if(ImageFlag) And (Canvas.Brush.Color = clHighlight) then begin
      if(FImageAlign = aliLeft) then
        r1.Left := r.Right + 1
      else r1.Right := r.Left - 1;
      DrawImageFocus(Index);
    end;
    FillRect(r1);
    if ImageFlag then begin
      InflateRect(r, -1, -1);
      Image := TBitmap.Create;
      FImageList.GetBitmap(GetImageIndex(Index), Image);
      StretchDraw(r, Image);
      Image.Free;
    end;
    if (FImageList <> Nil) then begin
      InflateRect(Rect, -2, -2);
      if(FImageAlign = aliLeft) then
        Rect.Left := r.Right + 2
      else Rect.Right := r.Left - 2;
    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 Or DT_EDITCONTROL);
      FItemTextHeight := r.Bottom - r.Top;
    end;
  end;
end;

procedure TAutoCustomImageListBox.CNDrawItem(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Message.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State) else
      Canvas.FillRect(rcItem);
    if odFocused in State then begin
      if(FImageList <> Nil) then
        InflateRect(rcItem, -2, -3);
      DrawFocusRect(hDC, rcItem);
    end;
    Canvas.Handle := 0;
  end;
end;


procedure TAutoCustomImageListBox.SetInheritedItemHeight;
Var
  h : Integer;
begin
    if(FItemHeight < 10) then begin
      Canvas.Font.Size := Font.Size;
      h := Canvas.TextHeight('Wg');
      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;
end;

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

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

procedure TAutoCustomImageListBox.DrawImageFocus(Index : Integer);
Var
  r : TRect;
  SColor : TColor;
begin
  if (FImageList <> Nil) then begin
    if(Index > -1) And (FDrawEdgeIndex <> Index) then begin
      if(FDrawEdgeIndex > -1) And (ImageIndexes[FDrawEdgeIndex] > -1)
      And (ImageIndexes[FDrawEdgeIndex] < FImageList.Count) then begin
        r := GetImageRect(FDrawEdgeIndex);
        SColor := Canvas.Brush.Color;
        Canvas.Brush.Color := Color;
        Canvas.FrameRect(r);
        Canvas.Brush.Color := SColor;
      end;
      FDrawEdgeIndex := Index;
      if(FDrawEdgeIndex > -1) And (ImageIndexes[FDrawEdgeIndex] > -1)
      And (ImageIndexes[FDrawEdgeIndex] < FImageList.Count) then begin
        r := GetImageRect(FDrawEdgeIndex);
        DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
        Dec(R.Bottom);
        Dec(R.Right);
        if(Color = clWindow) Or (Color = clWhite) then
          DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_TOPLEFT)
       else DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_TOPLEFT);
      end;
    end;
  end;
end;

{procedure TAutoCustomImageListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
Var
  Item : Integer;
  r : TRect;
  p : TPoint;
  St : String;
  FHideFlag : Boolean;
begin
  inherited;
  if Not FMultiLines then exit;
  p.X := X;
  p.Y := Y;
  Item := ItemAtPos(p, True);
  FHideFlag := Item = -1;
  if(Item <> FHintIndex) then begin
    FHintIndex := Item;
    if(FHintIndex <> -1) then begin
      Item := r.Bottom - r.Top;
      p.X := Left;
      p.Y := Y;
      p := ClientToScreen(p);
      Inc(p.X, Item);
      SetRect(r, p.X, p.Y, p.X + Width, p.Y);
      St := Items[FHintIndex];
      DrawText(Canvas.Handle, PChar(St), Length(St) + 1, r,
      DT_LEFT Or DT_NOPREFIX Or DT_WORDBREAK Or DT_CALCRECT);
      if(FItemTextHeight < r.Bottom - r.Top) then begin
        InflateRect(r, 2, 2);
        FHintWindow.ActivateHint(r, St);
        FHintWindowShowing := True;
      end else FHideFlag := True;
    end;
  end;
  if FHideFlag And FHintWindowShowing then begin
    FHintWindowShowing := False;
    SetWindowPos(FHintWindow.Handle, 0, 0, 0, 0, 0, SWP_HIDEWINDOW);
  end;
end;}

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