cximage.pas

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

procedure TcxCustomImage.CopyToClipboard;
begin
  if (FPicture <> nil) and (FPicture.Graphic <> nil) then
    Clipboard.Assign(FPicture);
end;

procedure TcxCustomImage.CutToClipboard;
begin
  CopyToClipboard;
  EditAndClear;
end;

function TcxCustomImage.Focused: Boolean;
begin
  Result := FIsDialogShowed or inherited Focused;
end;

class function TcxCustomImage.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxCustomImageProperties;
end;

procedure TcxCustomImage.LoadFromFile;

  function GetDialogFilter: string;
  var
  AGraphicClass: TGraphicClass;
      begin
        if ActiveProperties.CustomFilter <> '' then
      Result := ActiveProperties.CustomFilter
        else
        begin
          AGraphicClass := ActiveProperties.GraphicClass;
          if AGraphicClass <> nil then
        Result := GraphicFilter(AGraphicClass)
          else
        Result := GraphicFilter(TGraphic);
        end;
  end;

var
  ADialog: TOpenPictureDialog;
begin
  if not CanModify then
    Exit;
  ADialog := TOpenPictureDialog.Create(nil);
        try
    FIsDialogShowed := True;
    ADialog.Filter := GetDialogFilter;
    if ADialog.Execute and DoEditing then
          begin
      FPicture.LoadFromFile(ADialog.FileName);
            DoClosePopup(crEnter);
          end
          else
            DoClosePopup(crCancel);
    Application.ProcessMessages;
        finally
          FIsDialogShowed := False;
      ADialog.Free;
    end;
end;

procedure TcxCustomImage.PasteFromClipboard;
{$IFDEF USEJPEGIMAGE}
var
  AGraphicClass: TGraphicClass;
  AGraphic: TJPEGImage;
{$ENDIF}
begin
  if CanPasteFromClipboard and DoEditing then
    if Clipboard.HasFormat(CF_BITMAP) then
    begin
{$IFDEF USEJPEGIMAGE}
      AGraphicClass := GetGraphicClass(True);
      if (AGraphicClass = TJPEGImage) then
      begin
        AGraphic := TJPEGImage.Create;
        try
          TJPEGImageAccess(AGraphic).NewBitmap;
          TJPEGImageAccess(AGraphic).Bitmap.Assign(Clipboard);
          AGraphic.JPEGNeeded;
          FPicture.Graphic := AGraphic;
        finally
          AGraphic.Free;
        end;
      end
      else
{$ENDIF}
        FPicture.Bitmap.Assign(Clipboard);
    end
    else
      FPicture.Assign(Clipboard);
end;

procedure TcxCustomImage.SaveToFile;
var
  ADialog: TSavePictureDialog;
begin
  if (FPicture = nil) or (FPicture.Graphic = nil) then
    Exit;
  ADialog := TSavePictureDialog.Create(Application);
  FIsDialogShowed := True;
    try
        if ActiveProperties.CustomFilter <> '' then
      ADialog.Filter := ActiveProperties.CustomFilter
        else
      ADialog.Filter := GraphicFilter(TGraphicClass(FPicture.Graphic.ClassType));
    ADialog.DefaultExt := GraphicExtension(TGraphicClass(FPicture.Graphic.ClassType));
    if ADialog.Execute then
      FPicture.SaveToFile(ADialog.FileName);
    Application.ProcessMessages;
        finally
          FIsDialogShowed := False;
    ADialog.Free;
  end;
end;

{ TcxImage }

class function TcxImage.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxImageProperties;
end;

function TcxImage.GetActiveProperties: TcxImageProperties;
begin
  Result := TcxImageProperties(InternalGetActiveProperties);
end;

function TcxImage.GetProperties: TcxImageProperties;
begin
  Result := TcxImageProperties(FProperties);
end;

procedure TcxImage.SetProperties(Value: TcxImageProperties);
begin
  FProperties.Assign(Value);
end;

{ TcxImageViewInfo }

destructor TcxImageViewInfo.Destroy;
begin
  if FFreePicture then
    Picture.Free;
  FTempBitmap.Free;
  inherited Destroy;
end;

procedure TcxImageViewInfo.DrawTransparentBackground(ACanvas: TcxCanvas; const R: TRect);
begin
  ACanvas.SaveClipRegion;
  try
    ACanvas.SetClipRegion(TcxRegion.Create(R), roIntersect);
    cxDrawTransparentControlBackground(Edit, ACanvas, Bounds);
  finally
    ACanvas.RestoreClipRegion;
  end;
end;

procedure TcxImageViewInfo.InternalPaint(ACanvas: TcxCanvas);

  procedure FocusRect(ACanvas: TCanvas; R: TRect);
  begin
    ACanvas.Brush.Style := bsClear;
    ACanvas.Rectangle(R);
    ACanvas.Brush.Style := bsSolid;
  end;

var
  CR, R, Temp: TRect;
  NeedDrawBkg: Boolean;
  SaveRgn: TcxRegion;
  ARealStretch: Boolean;
begin
  CR := ClientRect;
  if Self.Transparent then
    DrawTransparentBackground(ACanvas, Bounds);
  with ACanvas do
  begin
    if not Assigned(Picture) or IsPictureEmpty(Picture) then
    begin
      inherited InternalPaint(ACanvas);
      Brush.Color := BackgroundColor;
      if Caption <> '' then
      begin
        Brush.Style := bsClear;
        Canvas.Font.Assign(Self.Font);
        Canvas.Font.Color := Self.TextColor;
        ACanvas.DrawText(Caption, CR, cxAlignCenter + cxSingleLine);
        Brush.Style := bsSolid;
      end;
      if ShowFocusRect then FocusRect(Canvas, CR);
      Exit;
    end;
    with CR do
    begin
      ARealStretch := Stretch or (Proportional and
        ((Picture.Height > cxRectHeight(CR)) or (Picture.Width > cxRectWidth(CR))));
      if ARealStretch then
      begin
        if Proportional then
          CalcStretchRect(CR, Picture.Width, Picture.Height, R)
        else
          R := CR;
      end
      else
        R := cxRectBounds(Left, Top, Picture.Width, Picture.Height);

      if Center then
      begin
        OffsetRect(R, (Right - Left - cxRectWidth(R)) div 2, 0);
        OffsetRect(R, 0, (Bottom - Top - cxRectHeight(R)) div 2);
      end
      else
        OffsetRect(R, -Self.TopLeft.X, -Self.TopLeft.Y);
    end;
    SaveRgn := GetClipRegion; // for native mode
    ExcludeClipRect(CR);
    DrawCustomEdit(ACanvas, Self, False, bpsSolid);
    SetClipRegion(SaveRgn, roSet);
    if ShowFocusRect then
    begin
      FocusRect(Canvas, CR);
      InflateRect(CR, -1, -1);
    end;
    SaveRgn := GetClipRegion;
    IntersectClipRect(CR);
    if ShowFocusRect then InflateRect(CR, 1, 1);
    if not Self.Transparent and Picture.Graphic.Transparent then
    begin
      if FTempBitmap = nil then
      begin
        FTempBitmap := TBitmap.Create;
        FTempBitmap.PixelFormat := pfDevice;
      end;
      try
        FTempBitmap.Width := R.Right - R.Left;
        FTempBitmap.Height := R.Bottom - R.Top;
        FTempBitmap.Canvas.Brush.Color := BackgroundColor;
        FTempBitmap.Canvas.FillRect(Rect(0, 0, FTempBitmap.Width, FTempBitmap.Height));
        FTempBitmap.Canvas.StretchDraw(Rect(0, 0, FTempBitmap.Width, FTempBitmap.Height), Picture.Graphic);
        Canvas.Draw(R.Left, R.Top, FTempBitmap);
      except
        on EOutOfResources do
        begin
          Canvas.Brush.Color := BackgroundColor;
          Canvas.FillRect(ClientRect);
          Canvas.StretchDraw(R, Picture.Graphic);
        end;
      end;
    end
    else
      Canvas.StretchDraw(R, Picture.Graphic);
    NeedDrawBkg := not (IntersectRect(Temp, R, CR) and EqualRect(Temp, CR)) and not Self.Transparent;
    if NeedDrawBkg then
    begin
      ExcludeClipRect(R);
      Brush.Color := BackgroundColor;
      FillRect(CR);
    end;
    SetClipRegion(SaveRgn, roSet);
  end;
end;

function TcxImageViewInfo.IsRepaintOnStateChangingNeeded: Boolean;
begin
  Result := (not Assigned(Picture) or IsPictureEmpty(Picture)) and (Caption <> '');
end;

{ TcxImageViewData }

procedure TcxImageViewData.Calculate(ACanvas: TcxCanvas;
  const ABounds: TRect; const P: TPoint; Button: TcxMouseButton;
  Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo; AIsMouseEvent: Boolean);
var
  AProperties: TcxCustomImageProperties;
begin
  inherited Calculate(ACanvas, ABounds, P, Button, Shift, AViewInfo, AIsMouseEvent);
  if IsRectEmpty(ABounds) then
    Exit;
  AProperties := TcxCustomImageProperties(Properties);
  with TcxImageViewInfo(AViewInfo) do
  begin
    Caption := AProperties.Caption;
    Center := AProperties.Center;
    ShowFocusRect := AProperties.ShowFocusRect and Focused and not IsInplace;
    Stretch := AProperties.Stretch;
    Proportional := AProperties.Proportional;
    if Center or Stretch then
      TopLeft := Point(0, 0);
  end;
end;

procedure TcxImageViewData.EditValueToDrawValue(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue; AViewInfo: TcxCustomEditViewInfo);
var
  AGraphicClass: TGraphicClass;
begin
  with TcxImageViewInfo(AViewInfo) do
    if VarIsStr(AEditValue) and (AEditValue <> '') then
    begin
      if not Assigned(Picture) then
      begin
        Picture := TPicture.Create;
        FFreePicture := True;
      end;
      AGraphicClass := TcxCustomImageProperties(Properties).GetGraphicClass(
        InplaceEditParams.Position.Item, InplaceEditParams.Position.RecordIndex);
      LoadPicture(Picture, AGraphicClass, AEditValue);
      if TcxCustomImageProperties(Properties).GraphicTransparency <> gtDefault then
        Picture.Graphic.Transparent :=
          TcxCustomImageProperties(Properties).GraphicTransparency = gtTransparent;
    end
    else
      if Assigned(Picture) then
        Picture.Assign(nil);
end;

function TcxImageViewData.GetEditContentSize(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue;
  const AEditSizeProperties: TcxEditSizeProperties): TSize;
var
  ABorderExtent: TRect;
  AGraphicClass: TGraphicClass;
  APicture: TPicture;
  S: string;
begin
  if IsInplace then
  begin
    if Edit <> nil then
    begin
      Result := Size(Edit.Width, Edit.Height);
      ABorderExtent := GetBorderExtent;
      Result.cx := Result.cx - (ABorderExtent.Left + ABorderExtent.Right);
      Result.cy := Result.cy - (ABorderExtent.Top + ABorderExtent.Bottom);
    end
    else
      with TcxCustomImageProperties(Properties) do
      begin
        Result := Size(0, DefaultHeight);
        if VarIsStr(AEditValue) then
        begin
          AGraphicClass := GetGraphicClass(InplaceEditParams.Position.Item,
            InplaceEditParams.Position.RecordIndex);
          APicture := TPicture.Create;
          try
            S := AEditValue;
            LoadPicture(APicture, AGraphicClass, S);
            Result := Size(APicture.Width, APicture.Height);
          finally
            APicture.Free;
          end;
          if Stretch then
            if (AEditSizeProperties.Width > 0) and (Result.cx > 0) then
              Result := Size(AEditSizeProperties.Width, Round(Result.cy * AEditSizeProperties.Width / Result.cx))
            else
              if (AEditSizeProperties.Height > 0) and (Result.cy > 0) then
                Result := Size(Round(Result.cx * AEditSizeProperties.Height / Result.cy), AEditSizeProperties.Height);
        end
        else
          if Length(Caption) <> 0 then
          begin
            ACanvas.Font := Style.GetVisibleFont;
            Result := ACanvas.TextExtent(Caption);
          end;
      end;
  end
  else
    if Edit <> nil then
      with TcxCustomImage(Edit) do
        Result := Size(Picture.Width, Picture.Height)
    else
      Result := Size(0, 0);
end;

procedure LoadPopupMenuImages;

  function GetResourceName(APopupMenuItem: TcxPopupMenuItem): string;
  begin
    case APopupMenuItem of
      pmiCut:
        Result := 'CXMENUIMAGE_CUT';
      pmiCopy:
        Result := 'CXMENUIMAGE_COPY';
      pmiPaste:
        Result := 'CXMENUIMAGE_PASTE';
      pmiDelete:
        Result := 'CXMENUIMAGE_DELETE';
      pmiLoad:
        Result := 'CXMENUIMAGE_LOAD';
      pmiSave:
        Result := 'CXMENUIMAGE_SAVE';
      else
        Result := '';
    end;
  end;

  procedure LoadBitmapFromResource(ABitmap: TBitmap;
    APopupMenuItem: TcxPopupMenuItem);
  begin
    ABitmap.LoadFromResourceName(HInstance, GetResourceName(APopupMenuItem));
  end;

var
  ABitmap: TBitmap;
  APopupMenuItem: TcxPopupMenuItem;
begin
  ABitmap := TBitmap.Create;
  try
    LoadBitmapFromResource(ABitmap, Low(TcxPopupMenuItem));
    if cxGraphicPopupMenuImages = nil then
      cxGraphicPopupMenuImages := TImageList.CreateSize(ABitmap.Width, ABitmap.Height);
    cxGraphicPopupMenuImages.AddMasked(ABitmap, clDefault);

    for APopupMenuItem := Succ(Low(TcxPopupMenuItem)) to High(TcxPopupMenuItem) do
    begin
      if APopupMenuItem = pmiCustom then
        Continue;
      LoadBitmapFromResource(ABitmap, APopupMenuItem);
      cxGraphicPopupMenuImages.AddMasked(ABitmap, clDefault);
    end;
  finally
    ABitmap.Free;
  end;
end;

initialization
  LoadPopupMenuImages;
  GetRegisteredEditProperties.Register(TcxImageProperties, scxSEditRepositoryImageItem);

finalization
  FreeAndNil(cxRegisteredGraphicClasses);
  FreeAndNil(cxGraphicPopupMenuImages);

end.