cximage.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,762 行 · 第 1/4 页

function TcxCustomImage.GetActiveProperties: TcxCustomImageProperties;
begin
  Result := TcxCustomImageProperties(InternalGetActiveProperties);
end;

procedure TcxCustomImage.MenuItemClick(Sender: TObject;
  MenuItem: TcxPopupMenuItem);
begin
  KeyboardAction := True;
  try
    case MenuItem of
      pmiCut: CutToClipboard;
      pmiCopy: CopyToClipboard;
      pmiPaste: PasteFromClipboard;
      pmiDelete: EditAndClear;
      pmiLoad: LoadFromFile;
      pmiSave: SaveToFile;
      pmiCustom: CustomClick;
    end;
  finally
    KeyboardAction := False;
  end;
end;

procedure TcxCustomImage.PictureChanged(Sender: TObject);
var
  PrevEvent: TNotifyEvent;
begin
  LockChangeEvents(True);
  try
    if Picture.Graphic is TIcon then // Otherwise the Icon returns the incorrect sizes
      TIcon(Picture.Graphic).Handle; // HandleNeeded;

    if ActiveProperties.GraphicTransparency <> gtDefault then
    begin
      PrevEvent := FPicture.OnChange;
      try
        FPicture.OnChange := nil;
        if not IsPictureEmpty(FPicture) then
          FPicture.Graphic.Transparent := ActiveProperties.GraphicTransparency = gtTransparent;
      finally
        FPicture.OnChange := PrevEvent;
      end;
    end;
    if not (csLoading in ComponentState) then
    begin
      ResetImage;
      SetSize;
    end;
    if not FInternalChanging then
    begin
      if KeyboardAction then
        ModifiedAfterEnter := True;
      DoChange;
      ShortRefreshContainer(False);
    end;
    if ActiveProperties.ImmediatePost and CanPostEditValue and ValidateEdit(True) then
      InternalPostEditValue;
  finally
    LockChangeEvents(False);
  end;
  UpdateScrollBars;
end;

procedure TcxCustomImage.PreparePopup;

  procedure RefreshCaptions;
  begin
    with FEditPopupMenu do
    begin
      Items[0].Caption := cxGetResourceString(@cxSMenuItemCaptionCut);
      Items[1].Caption := cxGetResourceString(@cxSMenuItemCaptionCopy);
      Items[2].Caption := cxGetResourceString(@cxSMenuItemCaptionPaste);
      Items[3].Caption := cxGetResourceString(@cxSMenuItemCaptionDelete);
      Items[5].Caption := cxGetResourceString(@cxSMenuItemCaptionLoad);
      Items[6].Caption := cxGetResourceString(@cxSMenuItemCaptionSave);
    end;
  end;

  function NewItem(const ACaption: string; ABitmap: TBitmap;
    ATag: Integer): TMenuItem;
  begin
    Result := TMenuItem.Create(Self);
    with Result do
    begin
      Caption := ACaption;
      if Assigned(ABitmap) then Bitmap := ABitmap else ImageIndex := ATag;
      Tag := ATag;
      OnClick := EditPopupMenuClick;
    end;
  end;

  procedure AddItem(AItems: TMenuItem; AMenuItem: TcxPopupMenuItem);
  begin
    with AItems do
    begin
      if AMenuItem = pmiCustom then
      begin
        ActiveProperties.PopupMenuLayout.CustomMenuItemGlyph.Transparent := True;
        Add(NewItem(ActiveProperties.PopupMenuLayout.CustomMenuItemCaption,
          ActiveProperties.PopupMenuLayout.CustomMenuItemGlyph, Integer(AMenuItem)));
      end
      else
        Add(NewItem('', nil, Integer(AMenuItem)));
      if AMenuItem in [pmiDelete, pmiSave] then
        Add(NewItem('-', nil, -1));
    end;
  end;

var
  I: TcxPopupMenuItem;
  AFlagRO, AFlagEmpty, AIsIcon, ACanPaste: Boolean;
begin
  with ActiveProperties.PopupMenuLayout do
  begin
    if FEditPopupMenu = nil then
    begin
      FEditPopupMenu := TPopupMenu.Create(nil);
      FEditPopupMenu.Images := cxGraphicPopupMenuImages;
      for I := Low(TcxPopupMenuItem) to High(TcxPopupMenuItem) do
        AddItem(FEditPopupMenu.Items, I);
    end;
    RefreshCaptions;
    // visible
    with FEditPopupMenu do
    begin
      Items[0].Visible := pmiCut in MenuItems;
      Items[1].Visible := pmiCopy in MenuItems;
      Items[2].Visible := pmiPaste in MenuItems;
      Items[3].Visible := pmiDelete in MenuItems;
      Items[5].Visible := pmiLoad in MenuItems;
      Items[6].Visible := pmiSave in MenuItems;
      Items[8].Visible := pmiCustom in MenuItems;
      // Separators
      Items[4].Visible := Items[5].Visible or Items[6].Visible;
      Items[7].Visible := Items[8].Visible;

      AIsIcon := ActiveProperties.GraphicClass = TIcon;

      ACanPaste := CanPasteFromClipboard;
      // Custom Item
      with Items[8] do
      begin
        Caption := CustomMenuItemCaption;
        Bitmap := CustomMenuItemGlyph;
      end;

      AFlagRO := not CanModify;
      AFlagEmpty := IsPictureEmpty(FPicture);
      Items[0].Enabled := not (AFlagEmpty or AFlagRO or AIsIcon);
      Items[1].Enabled := not AFlagEmpty and not AIsIcon;
      Items[2].Enabled := not AFlagRO and ACanPaste;
      Items[3].Enabled := not AFlagEmpty and not AFlagRO;
      Items[5].Enabled := not AFlagRO;
      Items[6].Enabled := not AFlagEmpty;
    end;
  end;
end;

procedure TcxCustomImage.ResetImage;
begin
  HScrollBar.Position := 0;
  VScrollBar.Position := 0;
  SynchronizeImage;
end;

procedure TcxCustomImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TcxCustomImage.SetProperties(const Value: TcxCustomImageProperties);
begin
  FProperties.Assign(Value);
end;

procedure TcxCustomImage.SetTransparent(AValue: Boolean);
begin
  if AValue <> FTransparent then
  begin
    FTransparent := AValue;
    ViewInfo.Transparent := FTransparent;
    InvalidateRect(ViewInfo.ClientRect, False);
  end;
end;

procedure TcxCustomImage.SynchronizeImage;
begin
  if not HandleAllocated then Exit;
  with TcxImageViewInfo(ViewInfo) do
  begin
    if HScrollBar.Visible then TopLeft.X := HScrollBar.Position else TopLeft.X := 0;
    if VScrollBar.Visible then TopLeft.Y := VScrollBar.Position else TopLeft.Y := 0;
  end;
  CalculateViewInfo(False);
  InvalidateRect(ViewInfo.ClientRect, False);
end;

function TcxCustomImage.CanAutoSize: Boolean;
begin
  Result := inherited CanAutoSize and not IsPictureEmpty(Picture);
end;

function TcxCustomImage.CanAutoWidth: Boolean;
begin
  Result := True;
end;

procedure TcxCustomImage.DoContextPopup( MousePos: TPoint;
  var Handled: Boolean);
var
  P: TPoint;
begin
  if (PopupMenu = nil) and (ActiveProperties.PopupMenuLayout.MenuItems <> []) then
  begin
    Handled := True;
    P := MousePos;
    if (P.X = -1) and (P.Y = -1) then
    begin
      P.X := 10;
      P.Y := 10;
    end;
    // Popup
    PreparePopup;
    P := ClientToScreen(P);
    FEditPopupMenu.Popup(P.X, P.Y);
  end
  else
    inherited;
end;

procedure TcxCustomImage.Initialize;
begin
  inherited Initialize;
  AutoSize := False;
  Width := 140;
  Height := 100;
  FClipboardFormat := CF_PICTURE;
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  TcxImageViewInfo(ViewInfo).Picture := FPicture;
end;

procedure TcxCustomImage.InitScrollBarsParameters;
begin
  if IsInplace or AutoSize or IsRectEmpty(ClientBounds) or IsPictureEmpty(Picture) or // TODO
    ActiveProperties.Center or ActiveProperties.Stretch then                          // TODO
      Exit;
  with ClientBounds do
  begin
    SetScrollBarInfo(sbHorizontal, 0, Picture.Width - 1, 8, Right - Left,
      TcxImageViewInfo(ViewInfo).TopLeft.X, True, True);
    SetScrollBarInfo(sbVertical, 0, Picture.Height - 1, 8, Bottom - Top,
      TcxImageViewInfo(ViewInfo).TopLeft.Y, True, True);
  end;
  SynchronizeImage;
end;

procedure TcxCustomImage.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  KeyboardAction := True;
  try
    case Key of
      VK_INSERT:
        if ssShift in Shift then
          PasteFromClipBoard
        else
          if ssCtrl in Shift then
            CopyToClipBoard;
      VK_DELETE:
        if ssShift in Shift then
          CutToClipBoard;
    end;
  finally
    KeyboardAction := False;
  end;
end;

procedure TcxCustomImage.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  KeyboardAction := True;
  try
    case Key of
      ^X: CutToClipBoard;
      ^C: CopyToClipBoard;
      ^V: PasteFromClipBoard;
    end;
  finally
    KeyboardAction := False;
  end;
end;

function TcxCustomImage.NeedsInvokeAfterKeyDown(AKey: Word;
  AShift: TShiftState): Boolean;
begin
  Result := inherited NeedsInvokeAfterKeyDown(AKey, AShift);
  case AKey of
    VK_INSERT:
      Result := AShift * [ssCtrl, ssShift] = [];
    VK_DELETE:
      Result := not (ssShift in AShift);
  end;
end;

function TcxCustomImage.NeedsScrollBars: Boolean;
begin
  Result := True;
end;

procedure TcxCustomImage.Scroll(AScrollBarKind: TScrollBarKind;
  AScrollCode: TScrollCode; var AScrollPos: Integer);
begin
  case AScrollCode of
   scLineUp:
     Dec(AScrollPos, 8);
   scLineDown:
     Inc(AScrollPos, 8);
  end;
  case AScrollBarKind of
    sbVertical:
      begin
        AScrollPos := Min(AScrollPos, Picture.Height - VScrollBar.PageSize);
        VScrollBar.Position := AScrollPos;
        AScrollPos := VScrollBar.Position;
      end;
    sbHorizontal:
      begin
        AScrollPos := Min(AScrollPos, Picture.Width - HScrollBar.PageSize);
        HScrollBar.Position := AScrollPos;
        AScrollPos := HScrollBar.Position;
      end;
  end;
  SynchronizeImage;
end;

function TcxCustomImage.GetEditValue: TcxEditValue;
var
  S: AnsiString;
begin
  if IsPictureEmpty(FPicture) then
    Result := Null
  else
  begin
    SavePicture(FPicture, S);
    Result := S;
  end;
end;

procedure TcxCustomImage.InternalSetEditValue(const Value: TcxEditValue; AIsValueValid: Boolean);
begin
  FInternalChanging := True;
  try
    if VarIsStr(Value) then
      LoadPicture(Picture, GetGraphicClass, Value)
    else
      Picture.Assign(nil);
  finally
    EditModified := False;
    FInternalChanging := False;
  end;
end;

procedure TcxCustomImage.PropertiesChanged(Sender: TObject);
begin
  if not PropertiesChangeLocked then
  begin
    PictureChanged(nil);
    UpdateScrollBars;
    inherited PropertiesChanged(Sender)
  end;
end;

procedure TcxCustomImage.UpdateScrollBars;
begin
  inherited UpdateScrollBars;
  SynchronizeImage;
end;

function TcxCustomImage.CanPasteFromClipboard: Boolean;
var
  AGraphicClass: TGraphicClass;
begin
  AGraphicClass := ActiveProperties.GraphicClass;
  if AGraphicClass = TBitmap then
    Result := Clipboard.HasFormat(CF_BITMAP)
  else if AGraphicClass = TIcon then
    Result := False
  else if AGraphicClass = TMetafile then
    Result := Clipboard.HasFormat(CF_METAFILEPICT)
  {$IFDEF USEJPEGIMAGE}
  else if AGraphicClass = TJPEGImage then
    Result := Clipboard.HasFormat(CF_BITMAP)
  {$ENDIF}
  else if AGraphicClass = nil then
    Result := Clipboard.HasFormat(CF_PICTURE)
  else
    Result := Clipboard.HasFormat(ClipboardFormat);
end;

procedure TcxCustomImage.CustomClick;
begin
  with Properties do
    if Assigned(OnCustomClick) then
      OnCustomClick(Self);
  if RepositoryItem <> nil then
    with ActiveProperties do
      if Assigned(OnCustomClick) then
        OnCustomClick(Self);
end;

procedure TcxCustomImage.DoOnAssignPicture;
begin
  with Properties do
    if Assigned(OnAssignPicture) then
      OnAssignPicture(Self, Picture);
  if RepositoryItem <> nil then
    with ActiveProperties do
      if Assigned(OnAssignPicture) then
        OnAssignPicture(Self, Picture);
end;

function TcxCustomImage.GetGraphicClass(APastingFromClipboard: Boolean = False): TGraphicClass;
begin
  if IsInplace then
    Result := ActiveProperties.GetGraphicClass(InplaceParams.Position.Item,
      InplaceParams.Position.RecordIndex, APastingFromClipboard)
  else
  begin
    Result := ActiveProperties.GraphicClass;
    if Result = nil then
    begin
      if APastingFromClipboard then
        Result := TBitmap;
      if Assigned(FOnGetGraphicClass) then
        FOnGetGraphicClass(Self, APastingFromClipboard, Result);
    end;
  end;
end;