⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 storepicture.pas

📁 delphi图形程序开发,就是怎么样给图片加文字
💻 PAS
字号:
unit StorePicture;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, XsImageEffect, WinSkinData;

const
  FIXWIDTH = 550;
  FIXHEIGHT = 350;

type
  TFormPicture = class(TForm)
    XsImageEffect1: TXsImageEffect;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    OrgBitmap: TBitmap;
    { Private declarations }
  public
    procedure AutoAdjustPosition();
    procedure AutoAdjustSize();
    procedure SetTopBottomMirror();
    procedure SetLeftRightMirror();
    procedure DragPicture();
    procedure EnabledSelect();
    procedure DisabledSelect();
    function ActiveSelect(): Boolean;
    procedure AutoSelect();
    procedure EraseBlack();
    procedure CutOutSelect();
    procedure LeftRotate90();
    procedure RightRotate90();
    procedure Rotate180();
    procedure CustomeRotate(Value: Integer);
    procedure ClientSize();
    procedure FullSize();
    procedure Zoom(Value: Integer);
    procedure OrgPictrue();
    procedure SelectAll();
    function GetBaseColor(): Integer;
    function GetColorArea(): Integer;
    function GetBKColor(): TColor;
    function GetTransparent(): Boolean;
    procedure SetBaseColor(Value: Integer);
    procedure SetColorArea(Value: Integer);
    procedure SetBKColor(Value: TColor);
    procedure SetTransparent(Value: Boolean);
    function GetBitmap(): TBitmap;
    { Public declarations }
  end;

var
  FormPicture: TFormPicture;

  procedure ShowPicture(Bitmap: TBitmap);

implementation

uses PictureProc;

{$R *.dfm}

procedure ShowPicture(Bitmap: TBitmap);
begin
  FormPicture:= TFormPicture.Create(Application);
  FormPicture.XsImageEffect1.Picture.Assign(Bitmap);
  FormPicture.OrgBitmap:= TBitmap.Create;
  FormPicture.OrgBitmap.Assign(Bitmap);
  FormPicture.Width:= 20;
  FormPicture.Height:= 20;
  FormPicture.AutoAdjustSize;
  FormPicture.ClientSize;
  FormPicture.Show;
end;

procedure TFormPicture.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (ssCtrl in Shift) and (Key = ord('A')) then
    XsImageEffect1.SelectAll
  else if Key=13 then
    CutOutSelect;
end;

procedure TFormPicture.FormCreate(Sender: TObject);
begin
  DoubleBuffered:= True;
  Left:= 35;
  Top:= 0;
end;

procedure TFormPicture.AutoAdjustPosition;
begin
  if XsImageEffect1.Width < ClientWidth then
    XsImageEffect1.Left:= (ClientWidth-XsImageEffect1.Width) div 2;
//  else
//    XsImageEffect1.Left:= 0;
  if XsImageEffect1.Height < ClientHeight then
    XsImageEffect1.Top:= (ClientHeight-XsImageEffect1.Height) div 2;
//  else
//    XsImageEffect1.Top:= 0;
end;

procedure TFormPicture.FormResize(Sender: TObject);
begin
//  AutoAdjustSize;
  AutoAdjustPosition;
end;

procedure TFormPicture.AutoAdjustSize;
begin
  if XsImageEffect1.Width > ClientWidth then
  begin
    XsImageEffect1.Left:= 0;
    if XsImageEffect1.Width > FIXWIDTH then
      ClientWidth:= FIXWIDTH
    else
      ClientWidth:= XsImageEffect1.Width;
  end;
  if XsImageEffect1.Height > ClientHeight then
  begin
    XsImageEffect1.Top:= 0;
    if XsImageEffect1.Height > FIXHEIGHT then
      ClientHeight:= FIXHEIGHT
    else
      ClientHeight:= XsImageEffect1.Height;
  end;
end;

procedure TFormPicture.AutoSelect;
begin
  XsImageEffect1.AutoSelectContent;
end;

procedure TFormPicture.ClientSize;
begin
  if not XsImageEffect1.Stretch then
  begin
    XsImageEffect1.Align:= alClient;
    XsImageEffect1.Stretch:= True;
  end;
end;

procedure TFormPicture.CutOutSelect;
begin
  XsImageEffect1.CutOutSelect;
end;

procedure TFormPicture.DragPicture();
begin
  if XsImageEffect1.DragInForm then
    XsImageEffect1.DragInForm:= False
  else
    XsImageEffect1.DragInForm:= True;
end;

procedure TFormPicture.EnabledSelect();
begin
  XsImageEffect1.SelectArea:= True;
end;

procedure TFormPicture.EraseBlack;
begin
  XsImageEffect1.GetPictureContent;
  if XsImageEffect1.Transparent then
  begin
    XsImageEffect1.AutoSelectContent;
    XsImageEffect1.CutOutSelect;
  end;
end;

procedure TFormPicture.FullSize;
begin
  if XsImageEffect1.Stretch then
  begin
    XsImageEffect1.Align:= alNone;
    XsImageEffect1.Stretch:= False;
    AutoAdjustPosition;
  end;
end;

procedure TFormPicture.LeftRotate90;
begin
  XsImageEffect1.SetRotateDegree:= -90;
end;

procedure TFormPicture.OrgPictrue;
begin
  XsImageEffect1.Picture.Assign(OrgBitmap);
end;

procedure TFormPicture.RightRotate90;
begin
  XsImageEffect1.SetRotateDegree:= 90;
end;

procedure TFormPicture.Rotate180;
begin
  XsImageEffect1.SetRotateDegree:= 180;
end;

procedure TFormPicture.SetLeftRightMirror;
begin
  XsImageEffect1.SetLeftRightMirror;
end;

procedure TFormPicture.SetTopBottomMirror;
begin
  XsImageEffect1.SetTopBottomMirror;
end;

procedure TFormPicture.Zoom(Value: Integer);
begin

end;

procedure TFormPicture.CustomeRotate(Value: Integer);
begin
  XsImageEffect1.SetRotateDegree:= Value;
end;

procedure TFormPicture.SelectAll;
begin
  XsImageEffect1.SelectAll;
end;

function TFormPicture.ActiveSelect: Boolean;
begin
  if XsImageEffect1.SelectArea then
  begin
    XsImageEffect1.SelectArea:= False;
    Result:= False;
  end else
  begin
    XsImageEffect1.SelectArea:= True;
    Result:= True;
  end;
end;

procedure TFormPicture.DisabledSelect;
begin
  XsImageEffect1.SelectArea:= False;
end;

function TFormPicture.GetBaseColor: Integer;
begin
  Result:= XsImageEffect1.BaseColor;
end;

function TFormPicture.GetBKColor: TColor;
begin
  Result:= XsImageEffect1.Color;
end;

function TFormPicture.GetColorArea: Integer;
begin
  Result:= XsImageEffect1.ColorArea;
end;

procedure TFormPicture.SetBaseColor(Value: Integer);
begin
  XsImageEffect1.BaseColor:= Value;
end;

procedure TFormPicture.SetBKColor(Value: TColor);
begin
  XsImageEffect1.Color:= Value;
end;

procedure TFormPicture.SetColorArea(Value: Integer);
begin
  XsImageEffect1.ColorArea:= Value;
end;

procedure TFormPicture.FormDestroy(Sender: TObject);
begin
  OrgBitmap.Free;
end;

function TFormPicture.GetTransparent: Boolean;
begin
  Result:= XsImageEffect1.Transparent;
end;

procedure TFormPicture.SetTransparent(Value: Boolean);
begin
  XsImageEffect1.Transparent:= Value;
end;

function TFormPicture.GetBitmap: TBitmap;
begin
  Result:= XsImageEffect1.Picture.Bitmap;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -