mmbmpdlg.pas

一套及时通讯的原码

                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapThumbIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value = Index) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index+1)
                                   else if (Value = Index+1) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index);
                                end;
                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapBackIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value = Index) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index+1)
                                   else if (Value = Index+1) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index);
                                end;
                             end;
                          end;
                       end;
                    end;
          umDelete: begin
                       for i := 0 to Form.ComponentCount-1 do
                       begin
                          PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapList');
                          if (PropInfo <> nil) then
                          begin
                             if Pointer(GetOrdProp(Form.Components[i], PropInfo)) = Pointer(FOrigList) then
                             begin
                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value > Index) then
                                       SetOrdProp(Form.Components[i],PropInfo,Value-1);
                                end;
                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapThumbIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value > Index) then
                                       SetOrdProp(Form.Components[i],PropInfo,Value-1);
                                end;
                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapBackIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value > Index) then
                                       SetOrdProp(Form.Components[i],PropInfo,Value-1);
                                end;
                             end;
                          end;
                       end;
                    end;
         end;
         for i := 0 to Form.ComponentCount-1 do
         begin
            PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'NumGlyphs');
            if (PropInfo <> nil) then
            begin
               idx := Comps.IndexOf(Form.Components[i].Name+' NumGlyphs');
               if (idx >= 0) then
               begin
                  SetOrdProp(Form.Components[i], PropInfo, integer(Comps.Objects[idx]));
               end;
            end;
            PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'NumThumbGlyphs');
            if (PropInfo <> nil) then
            begin
               idx := Comps.IndexOf(Form.Components[i].Name+' NumThumbGlyphs');
               if (idx >= 0) then
               begin
                  SetOrdProp(Form.Components[i], PropInfo, integer(Comps.Objects[idx]));
               end;
            end;
         end;
         Comps.Free;
      end;
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.BitmapListChanged(Sender: TObject);
begin
   UpdateListBox(ListBox.ItemIndex);
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.UpdateListBox(Index: integer);
var
   i: integer;

   function GetRefCount(idx: integer): integer;
   var
      Form: TCustomForm;
      i: integer;
      PropInfo: PPropInfo;

   begin
      Result := 0;
      if FUpdateIDs then
      begin
         Form := TCustomForm(FOrigList.Owner);
         if (Form <> nil) then
         begin
            for i := 0 to Form.ComponentCount-1 do
            begin
               PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapList');
               if (PropInfo <> nil) then
               begin
                  if Pointer(GetOrdProp(Form.Components[i], PropInfo)) = Pointer(FOrigList) then
                  begin
                     PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapIndex');
                     if (PropInfo <> nil) then
                     begin
                        if (GetOrdProp(Form.Components[i], PropInfo) = Idx) then inc(Result);
                     end;
                     PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapThumbIndex');
                     if (PropInfo <> nil) then
                     begin
                        if (GetOrdProp(Form.Components[i], PropInfo) = Idx) then inc(Result);
                     end;
                  end;
               end;
            end;
         end;
      end;
   end;

begin
   ListBox.Items.BeginUpdate;
   try
      ListBox.Clear;
      for i := 0 to FBitmapList.Count-1 do
      begin
         ListBox.Items.AddObject(IntToStr(i),Pointer(GetRefCount(i)));
      end;

      if (Index < 0) then
          Index := 0;

      if (Index >= ListBox.Items.Count) then
          Index := ListBox.Items.Count-1;

      if (Index < ListBox.Items.Count) then
          ListBox.ItemIndex := Index;

      UpdateControls;

   finally
      ListBox.Items.EndUpdate;
   end;
end;

{-- TFindMarkerForm -----------------------------------------------------}
procedure TMMBitmapListEditor.ListBoxDrawItem(Control: TWinControl;
                                              Index: Integer; Rect: TRect;
                                              State: TOwnerDrawState);
var
  R: TRect;
  S: string;
  C: array[0..255] of Char;
  X,Y,iWidth,iHeight,W: integer;
  Factor: Double;

begin
   with ListBox.Canvas do
   begin
      FillRect(Rect);

      inc(Rect.Top);
      dec(Rect.Bottom);
      R := Rect;

      { draw the ID }
      S := ListBox.Items[Index];
      R.Right := ListHeader.SectionWidth[0];
      X := (R.Left + ((R.Right-R.Left) div 2)) - TextWidth(S) div 2;
      Y := (R.Top + ((R.Bottom-R.Top) div 2)) - TextHeight(S) div 2;
      ExtTextOut(ListBox.Canvas.Handle, X, Y, ETO_CLIPPED or
                 ETO_OPAQUE, @R, StrPCopy(C, S), Length(S), nil);

      R.Left := R.Right;
      R.Right := Rect.Right;

      { draw the RefCount }
      S := IntToStr(integer(ListBox.Items.Objects[Index]));
      R.Right := ListHeader.SectionWidth[0]+ListHeader.SectionWidth[1];
      X := (R.Left + ((R.Right-R.Left) div 2)) - TextWidth(S) div 2;
      Y := (R.Top + ((R.Bottom-R.Top) div 2)) - TextHeight(S) div 2;
      ExtTextOut(ListBox.Canvas.Handle, X, Y, ETO_CLIPPED or
                 ETO_OPAQUE, @R, StrPCopy(C, S), Length(S), nil);

      R.Left := R.Right;
      R.Right := Rect.Right;
      inc(R.Top);
      dec(R.Bottom);

      iWidth  := FBitmapList.Items[index].Width;
      iHeight := FBitmapList.Items[index].Height;

      if (iWidth < (R.Right-R.Left)) and
         (iHeight < (R.Bottom-R.Top)) then
      begin
         R.Right := R.Left+iWidth;
         R.Top   := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
         R.Bottom:= R.Top + iHeight;
      end
      else
      begin
         if (iWidth <= iHeight) then
         begin
            if (iHeight > R.Bottom-R.Top) then
            begin
               Factor  := (R.Bottom - R.Top)/iHeight;
               iWidth  := Trunc(iWidth * Factor);
               iHeight := R.Bottom-R.Top;
            end;
            Factor  := Min(R.Bottom-R.Top,iHeight)/iHeight;
            iWidth  := Trunc(iWidth * Factor);
            if (iWidth > R.Right-R.Left) then
            begin
               Factor  := (R.Right - R.Left)/iWidth;
               iHeight := Trunc(iHeight * Factor);
               iWidth  := R.Right-R.Left;
               R.Top    := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
               R.Bottom := R.Top + iHeight;
            end;
            R.Right  := R.Left + iWidth;
         end
         else
         begin
            if (iHeight > R.Bottom-R.Top) then
            begin
               Factor  := (R.Bottom - R.Top)/iHeight;
               iWidth  := Trunc(iWidth * Factor);
               iHeight := R.Bottom-R.Top;
            end;
            W := Min(R.Right-R.Left,iWidth);
            Factor   := W/iWidth;
            iHeight  := Trunc(iHeight * Factor);
            R.Top    := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
            R.Bottom := R.Top + iHeight;
            R.Right := R.Left+W;
         end
      end;

      StretchDraw(R, FBitmapList.Items[index]);

      UpdateControls;
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.ListHeaderSized(Sender: TObject; ASection, AWidth: Integer);
begin
   ListBox.Invalidate;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.UpdateControls;
begin
   with ListBox do
   begin
      btnDelete.Enabled := (FBitmapList.Count > 0) and (ListBox.ItemIndex >= 0);
      menDelete.Enabled := btnDelete.Enabled;
      btnClear.Enabled  := (FBitmapList.Count > 0);
      menClear.Enabled  := btnClear.Enabled;
      btnSave.Enabled   := btnClear.Enabled;
      menSave.Enabled   := btnSave.Enabled;
      btnUp.Enabled     := (Items.Count > 0) and (ItemIndex > 0);
      menUp.Enabled     := btnUp.Enabled;
      btnDown.Enabled   := (Items.Count > 0) and (ItemIndex < Items.Count-1);
      menDown.Enabled   := btnDown.Enabled;
      btnCut.Enabled    := btnDelete.Enabled;
      menCut.Enabled    := btnCut.Enabled;
      btnCopy.Enabled   := btnDelete.Enabled;
      menCopy.Enabled   := btnCopy.Enabled;
      menSaveBMP.Enabled:= btnCopy.Enabled;
      btnPaste.Enabled  := Clipboard.HasFormat(CF_BITMAP);
      menPaste.Enabled  := btnPaste.Enabled;
      btnReplace.Enabled:= btnPaste.Enabled and (ListBox.ItemIndex >= 0) and (ListBox.Items.Count > 0);
      menReplace.Enabled:= btnReplace.Enabled;
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnOKClick(Sender: TObject);
begin
   ModalResult := mrOK;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.About1Click(Sender: TObject);
begin
   Show_AboutBox(0);
end;