dibeditor.pas

Delphi控件

  ImageAngle := AngleDial.Position;
end;

procedure TfmDIBEditor.stbStatusResize(Sender: TObject);
const
  //this is the panel index you want to take up the extra space
  PNL = 1;
var
  P, W: Integer;
begin
  with stbStatus do
  begin
    W := 0;
    for P := 0 to Panels.Count - 1 do
      if P <> PNL then W := W + Panels[P].Width;
    Panels[PNL].Width := ClientWidth - W;
  end;
end;

function TfmDIBEditor.GetImageMasked: Boolean;
begin
  Result := FCurrentImage.Masked;
end;

function TfmDIBEditor.GetTransColor: TColor;
begin
  Result := FCurrentImage.TransparentColor;
end;

function TfmDIBEditor.GetTransMode: TImageTransparencyMode;
const
  XMode: array [TTransparentMode] of TImageTransparencyMode =
    (itmAuto, itmFixed);
begin
  if not FCurrentImage.Transparent then
    Result := itmNone
  else
    Result := XMode[FCurrentImage.TransparentMode];
end;

procedure TfmDIBEditor.SetImageMasked(const Value: Boolean);
begin
  if Value <> FCurrentImage.Masked then
  begin
    FCurrentImage.Masked := Value;
    Modified := True;
  end;
end;

procedure TfmDIBEditor.SetTransColor(const Value: TColor);
begin
  FCurrentImage.TransparentColor := Value;
  shTransparentColor.Brush.Color := Value;
  Modified := True;
end;

procedure TfmDIBEditor.SetTransMode(const Value: TImageTransparencyMode);
const
  XMode: array [TImageTransparencyMode] of TTransparentMode =
    (tmAuto, tmAuto, tmFixed);
begin
  cbTransparentMode.ItemIndex := Ord(Value);
  with FCurrentImage do
  begin
    Transparent := (Value <> itmNone);
    if Transparent then TransparentMode := XMode[Value];
    //update the transparent color (Fixed to auto may change values)
    ImageTransparentColor := FCurrentImage.TransparentColor;
  end;
  Modified := True;
end;

procedure TfmDIBEditor.Resized(Sender: TObject);
var
  DIB: TMemoryDIB;
begin
  //Ensure we can still see the toolbox
  UpdateGUI;
  with DIBImageOptions do
  begin
    Left := DICRender.ClientWidth - (Width + 4);
    Top := 4;
  end;
  DIBImage1.Left := 0;
  DIBImage1.Top := 0;
  //do we need scrollbars?
  NeedScrollbars(Sender);
  DIB := DIBImageList1.DIBImages[0].DIB;
  if (DIB.Width = 1) and (DIB.Height = 1) then
    tbLoad.Click;
end;

procedure TfmDIBEditor.ToolBoxButtonClick(Sender: TObject);
var
  C: Integer;
  T: Integer;
begin
  //should not happen, but....
  if not (Sender is TSpeedButton) then Exit;
  T := Abs((Sender as TComponent).Tag);

  with DIBImageOptions do
    for C := 0 to ControlCount - 1 do
      if Controls[C].Tag > 0 then
        Controls[C].Visible := (T = Controls[C].Tag);
end;

procedure TfmDIBEditor.actExportImageExecute(Sender: TObject);
begin
  with spd1 do
  begin
    Title := 'Export Image';
    if Execute then
    begin
      FCurrentImage.ExportPicture(Filename);
      Modified := True;
    end;
  end;
end;

procedure TfmDIBEditor.actCloseCancelExecute(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfmDIBEditor.actExportMaskExecute(Sender: TObject);
begin
  with spd1 do
  begin
    Title := 'Export Image Mask';
    if Execute then
    begin
      FCurrentImage.ExportMask(Filename);
      Modified := True;
    end;
  end;
end;

procedure TfmDIBEditor.actExportMaskUpdate(Sender: TObject);
begin
  actExportMask.Enabled := FCurrentImage.Masked and
    (FCurrentImage.Height > 1) and (FCurrentImage.Width > 1);
end;

procedure TfmDIBEditor.actExportImageUpdate(Sender: TObject);
begin
  actExportImage.Enabled := (FCurrentImage.Height > 1) and (FCurrentImage.Width > 1);
end;

procedure TfmDIBEditor.actMaskFromFileUpdate(Sender: TObject);
begin
  actMaskFromFile.Enabled := (FCurrentImage.Height > 1) and (FCurrentImage.Width > 1);
  ToolboxEnable(actMaskFromFile.Enabled);
end;

procedure TfmDIBEditor.actCloseOKUpdate(Sender: TObject);
begin
  actCloseOK.Enabled := fModified and
    (FCurrentImage.Height > 1) and (FCurrentImage.Width > 1);
end;

procedure TfmDIBEditor.stbStatusDrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
var
  R: TRect;

  procedure DrawIcon(Icon: TBitmap);
  begin
    //think square
    R := Bounds(0, 0, Rect.Bottom - Rect.Top, Rect.Bottom - Rect.Top);
    OffSetRect(R, Rect.Left, Rect.Top);
    InflateRect(R, - 1, - 1);
    //draw the icon
    StatusBar.Canvas.BrushCopy(R, Icon,
      Bounds(0, 0, Icon.Width, Icon.Height), Icon.TransparentColor);
  end;

  procedure DoText(Text: string);
  begin
    with StatusBar.Canvas do
    begin
      Brush.Style := bsClear;
      OffsetRect(R, (R.Right - R.Left) + 2, 0);
      R.Right := Rect.Right;
      DrawText(Handle, PChar(Text), Length(Text), R,
        DT_VCENTER or DT_LEFT or DT_SINGLELINE);
    end;
  end;

  procedure DoXMode;
  const
    XMode: array [TImageTransparencyMode] of String = ('None', 'Auto', 'Fixed');
  begin
    DrawIcon(sbTransparent.Glyph);
    with StatusBar.Canvas do
    begin
      //draw the transparent color cube
      CopyMode := cmSrcCopy;
      OffsetRect(R, (R.Right - R.Left) + 2, 0);
      InflateRect(R, - 1, - 1);
      if FCurrentImage.Transparent then
      begin
        { TODO : Is there a fix for the quirky inverted colors? }
        Brush.Color := shTransparentColor.Brush.Color;
        Pen.Color := clBtnHighlight;
      end
      else
      begin
        Brush.Color := clWhite;
        Pen.Color := clBlack;
      end;
      RoundRect(R.Left, R.Top, R.Right, R.Bottom, 5, 5);

      //cross out the none transparent Display
      if not FCurrentImage.Transparent then
      begin
        MoveTo(R.Left, R.Top);
        LineTo(R.Right, R.Bottom);
      end;

      DoText(XMode[ImageTransparencyMode]);
    end;
  end;
begin
  case Panel.Index of
    0:;  //image modified panel
    1:;  //dead space
    2:;  //image size panel
    3:;  //Cursor Position panel
    4: DoXMode;  //Transparency Panel
    5: //Opaque Panel
      begin
        DrawIcon(sbOpacity.Glyph);
        DoText(IntToStr(ImageOpacity));
      end;
    6: //Angle Panel
      begin
        DrawIcon(sbAngle.Glyph);
        DoText(FloatToStr(ImageAngle));
      end;
    7:   //Scale Panel
      begin
        DrawIcon(sbScale.Glyph);
        DoText(IntToStr(ImageScale));
      end;
    8:;  //dead space
  end;
end;

procedure TfmDIBEditor.SetModified(const Value: Boolean);
begin
  fModified := Value;
  UpdateGUI;
  UpdateStatusBar;
end;

procedure TfmDIBEditor.ToolboxEnable(State: Boolean);
var 
  C: Integer;
begin
  with DIBImageOptions do
    for C := 0 to ControlCount - 1 do
      Controls[C].Enabled := State;
end;

procedure TfmDIBEditor.NeedScrollbars(Sender: TObject);
var 
  M: Integer;
begin
  with HScroller do
  begin
    Visible := DIBImage1.Width > (dicRender.Width - VScroller.Width);
    M := Round(DIBImage1.Width / dicRender.Width);
    if M = 0 then Max := 1 
    else 
      Max := M;
  end;
  with VScroller do
  begin
    Visible := DIBImage1.Height > (dicRender.Height - HScroller.Height);
    M := (DIBImage1.Height div dicRender.Height);
    if M = 0 then Max := 1 
    else 
      Max := M;
  end;
end;

procedure TfmDIBEditor.HScrollerChange(Sender: TObject);
begin
  with HScroller do
    if Position = 0 then
      DIBImage1.Left := 0
  else
    DIBImage1.Left := ((DIBImage1.Width - dicRender.Width) div Max) * -Position;
end;

procedure TfmDIBEditor.VScrollerChange(Sender: TObject);
begin
  with VScroller do
    if Position = 0 then
      DIBImage1.Top := 0
  else
    DIBImage1.Top := ((DIBImage1.Height - dicRender.Height) div Max) * -Position;
end;

procedure TfmDIBEditor.sbDropperClick(Sender: TObject);
const
  CSR: array[Boolean] of TCursor = (crDefault, crDropper);
begin
  if ImageTransparencyMode <> itmNone then
    DIBImage1.Cursor := CSR[sbDropper.Down]
  else
  begin
    sbDropper.Down := False;
    DIBImage1.Cursor := crDefault;
  end;
end;

procedure TfmDIBEditor.actRevertImageExecute(Sender: TObject);
begin
  //could use FCurrentImage.ResetHeader here, but we want the side effects of our properties
  ImageScale := 100;
  ImageOpacity := 255;
  ImageAngle := 0;
  ImageMasked := False;
  ImageTransparencyMode := itmNone;
end;

procedure TfmDIBEditor.actRevertImageUpdate(Sender: TObject);
begin
  actRevertImage.Enabled := (FCurrentImage.Height > 1) and (FCurrentImage.Width > 1) and fModified;
end;

procedure TfmDIBEditor.actImageFromClipboardExecute(Sender: TObject);
var
  BMP: TBitmap;
  HdlData, HdlPalette: THandle;
  WinDIB: TWinDIB;
  R: TRect;
begin
  BMP := TBitmap.Create;
  WinDIB := TWinDIB.Create;
  try
    //get the clipboard data. palette is unused
    HdlPalette := 0;    //shut the compiler up.
    HdlData := Clipboard.GetAsHandle(CF_BITMAP);
    BMP.LoadFromClipboardFormat(CF_BITMAP, HdlData, HdlPalette);
    with WinDIB do
    begin
      //transfer the image to the WinDIB
      Width := BMP.Width;
      Height := BMP.Height;
      R := Rect(0, 0, Width, Height);
      ClipRect := R;
      WinDIB.Canvas.CopyRect(R, BMP.Canvas, R);
    end;
    //Transfer the DIB to the running image
    FCurrentImage.Assign(WinDIB);
    Modified := True;
  finally
    BMP.Free;
    WinDIB.Free;
  end;
end;

procedure TfmDIBEditor.actImageFromClipboardUpdate(Sender: TObject);
begin
  actImageFromClipboard.Enabled := Clipboard.HasFormat(CF_BITMAP);
end;

procedure TfmDIBEditor.DIBImage1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //if the dropper is active, then select the color under the pixel
  if DIBImage1.Cursor = crDropper then
  begin
    ImageTransparentColor := Pixel32ToColor(FCurrentImage.Pixels[X, Y]);
  end;
end;

procedure TfmDIBEditor.DIBImage1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  stbStatus.Panels[3].Text := Format('X:%D Y:%D', [X, Y]);
end;

procedure TfmDIBEditor.DIBImage1MouseLeave(Sender: TObject);
begin
  stbStatus.Panels[3].Text := 'X:0 Y:0';
end;

procedure TfmDIBEditor.UpdateGUI;
begin
  if Assigned(FCurrentImage) then
    with FCurrentImage do
    begin
      udAngle.Position := Trunc(Angle);
      AngleDial.Position := Trunc(Angle);
      udOpacity.Position := Opacity;
      OpacitySlider.Position := Opacity;
      udScale.Position := Round(Scale);
      ScaleSlider.Position := udScale.Position;
      cbMasked.Checked := Masked;
      // CHANGED AZZA
      if (not Transparent) then
        cbTransparentMode.ItemIndex := 0
      else
        cbTransparentMode.ItemIndex := 1 + Ord(TransparentMode);
      shTransparentColor.Brush.Color := TransparentColor;
    end;
end;

procedure TfmDIBEditor.udAngleChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  //CAM: Workaround for spin edit bug
  if edAngle.Text <> '' then
    ImageAngle := udAngle.Position;
end;

procedure TfmDIBEditor.udOpacityChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  //CAM: Workaround for spin edit bug
  if edOpacity.Text <> '' then
    ImageOpacity := udOpacity.Position;
end;

procedure TfmDIBEditor.udScaleChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  //CAM: Workaround for spin edit bug
  if edScale.Text <> '' then
    ImageScale := udScale.Position;
end;

end.