pic-is-big/action.pas

unit action;

interface

uses
  Windows, SysUtils, StrUtils, Classes, Controls, Forms, Dialogs, StdCtrls, CallExec, plugin, pluginutil,
  IdMultiPartFormData, IdComponent, signal, ClipBrd, Graphics, Math, Consts, DateUtils,
  IdAntiFreezeBase, IdAntiFreeze, IdTCPConnection, IdHTTP, IdBaseComponent, ExtCtrls, IdTCPClient, Vcl.Menus;

{$I NoRTTI.inc}

type
  TFormAct = class(TForm)
    http: TIdHTTP;
    imgsend: TImage;
    IdAntiFreeze1: TIdAntiFreeze;
    PopupMenu1: TPopupMenu;
    N11: TMenuItem;
    N21: TMenuItem;
    N1: TMenuItem;
    Label1: TLabel;
    FromFile: TButton;
    FromClipbrd: TButton;
    CloseBtn: TButton;
    procedure CloseBtnClick(Sender: TObject);
    procedure FromFileClick(Sender: TObject);
    procedure FromClipbrdClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    // procedure WMDrawClipBoard(var Msg: TWMDrawClipBoard); message WM_DRAWCLIPBOARD;
    // procedure WMChangeCBChain(var Msg: TMessage); message WM_ChangeCBChain;
    { Public declarations }
  end;

  TInputQueryForm = class(TForm)
  public
    FCloseQueryFunc: TFunc;
  end;

var
  actfrm: TFormAct;
  hasimage: Boolean = false;
  fn, rply: string;
  LXBForm, LXSForm: TSForm;
  httpsize: integer;

implementation

uses setpassform, sett, picpop, clipfrm;

{$R *.dfm}

function GetAveCharSize(Canvas: TCanvas): TPoint;
{$IF DEFINED(CLR)}
var
  I: integer;
  Buffer: string;
  Size: TSize;
begin
  SetLength(Buffer, 52);
  for I := 0 to 25 do
    Buffer[I + 1] := Chr(I + Ord('A'));
  for I := 0 to 25 do
    Buffer[I + 27] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, Size);
  Result.X := Size.cx div 52;
  Result.Y := Size.cy;
end;
{$ELSE}

var
  I: integer;
  Buffer: array [0 .. 51] of Char;
begin
  for I := 0 to 25 do
    Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do
    Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;
{$IFEND}

function GetTextBaseline(AControl: TControl; ACanvas: TCanvas): integer;
var
  tm: TTextMetric;
  ClientRect: TRect;
  Ascent: integer;
begin
  ClientRect := AControl.ClientRect;
  GetTextMetrics(ACanvas.Handle, tm);
  Ascent := tm.tmAscent + 1;
  Result := ClientRect.Top + Ascent;
  Result := AControl.Parent.ScreenToClient(AControl.ClientToScreen(TPoint.Create(0, Result))).Y - AControl.Top;
end;

function MyInputQuery(const ACaption: string; const APrompts: array of string; var AValues: array of string;
  CloseQueryFunc: TInputCloseQueryFunc = nil): Boolean;
var
  I, J: integer;
  Form: TInputQueryForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  PromptCount, CurPrompt: integer;
  MaxPromptWidth: integer;
  ButtonTop, ButtonWidth, ButtonHeight: integer;
  MonNum: integer;

  function GetPromptCaption(const ACaption: string): string;
  begin
    if (Length(ACaption) > 1) and (ACaption[1] < #32) then
      Result := Copy(ACaption, 2, MaxInt)
    else
      Result := ACaption;
  end;

  function GetMaxPromptWidth(Canvas: TCanvas): integer;
  var
    I: integer;
    LLabel: TLabel;
  begin
    Result := 0;
    // Use a TLabel rather than an API such as GetTextExtentPoint32 to
    // avoid differences in handling characters such as line breaks.
    LLabel := TLabel.Create(nil);
    try
      for I := 0 to PromptCount - 1 do
      begin
        LLabel.Caption := GetPromptCaption(APrompts[I]);
        Result := Max(Result, LLabel.Width + DialogUnits.X);
      end;
    finally
      LLabel.Free;
    end;
  end;

  function GetPasswordChar(const ACaption: string): Char;
  begin
    if (Length(ACaption) > 1) and (ACaption[1] < #32) then
      Result := '*'
    else
      Result := #0;
  end;

begin
  if Length(AValues) < Length(APrompts) then
    raise EInvalidOperation.CreateRes(@SPromptArrayTooShort);
  PromptCount := Length(APrompts);
  if PromptCount < 1 then
    raise EInvalidOperation.CreateRes(@SPromptArrayEmpty);
  Result := false;
  MonNum := Screen.MonitorFromPoint(Mouse.CursorPos, mdNearest).MonitorNum;
  Form := TInputQueryForm.CreateNew(Application);
  with Form do
    try
      FCloseQueryFunc := function: Boolean
        var
          I, J: integer;
          LValues: array of string;
          Control: TControl;
        begin
          Result := True;
          if Assigned(CloseQueryFunc) then
          begin
            SetLength(LValues, PromptCount);
            J := 0;
            for I := 0 to Form.ControlCount - 1 do
            begin
              Control := Form.Controls[I];
              if Control is TEdit then
              begin
                LValues[J] := TEdit(Control).Text;
                Inc(J);
              end;
            end;
            Result := CloseQueryFunc(LValues);
          end;
        end;
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      MaxPromptWidth := GetMaxPromptWidth(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180 + MaxPromptWidth, DialogUnits.X, 4);
      PopupMode := pmAuto;
      Position := poDefault;
      Form.Top := Screen.Monitors[MonNum].Top + ((Screen.Monitors[MonNum].Height div 2) - (Form.ClientHeight div 2));
      Form.Left := Screen.Monitors[MonNum].Left + ((Screen.Monitors[MonNum].Width div 2) - (Form.ClientWidth div 2));
      CurPrompt := MulDiv(8, DialogUnits.Y, 8);
      Edit := nil;
      for I := 0 to PromptCount - 1 do
      begin
        Prompt := TLabel.Create(Form);
        with Prompt do
        begin
          Parent := Form;
          Caption := GetPromptCaption(APrompts[I]);
          Left := MulDiv(8, DialogUnits.X, 4);
          Top := CurPrompt;
          Constraints.MaxWidth := MaxPromptWidth;
          WordWrap := True;
        end;
        Edit := TEdit.Create(Form);
        with Edit do
        begin
          Parent := Form;
          PasswordChar := GetPasswordChar(APrompts[I]);
          Left := Prompt.Left + MaxPromptWidth;
          Top := Prompt.Top + Prompt.Height - DialogUnits.Y - (GetTextBaseline(Edit, Canvas) - GetTextBaseline(Prompt, Canvas));
          Width := Form.ClientWidth - Left - MulDiv(8, DialogUnits.X, 4);
          MaxLength := 255;
          Text := AValues[I];
          SelectAll;
          Prompt.FocusControl := Edit;
        end;
        CurPrompt := Edit.Top + Edit.Height + 5;
      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := SMsgDlgOK;
        ModalResult := mrOk;
        Default := True;
        SetBounds(Form.ClientWidth - (ButtonWidth + MulDiv(8, DialogUnits.X, 4)) * 2, ButtonTop, ButtonWidth, ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := SMsgDlgCancel;
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(Form.ClientWidth - (ButtonWidth + MulDiv(8, DialogUnits.X, 4)), ButtonTop, ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        J := 0;
        for I := 0 to ControlCount - 1 do
          if Controls[I] is TEdit then
          begin
            Edit := TEdit(Controls[I]);
            AValues[J] := Edit.Text;
            Inc(J);
          end;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

// [UIPermission(SecurityAction.LinkDemand, Window=UIPermissionWindow.SafeSubWindows)]
function MyInputBox(const ACaption, APrompt, ADefault: string): string;
var
  Values: array [0 .. 0] of string; rslt: Boolean;
begin
  Result := ADefault;
  Values[0] := ADefault;
  rslt := MyInputQuery(ACaption, [APrompt], Values);
  if rslt then
    Result := Values[0];
end;

function GetContentType(Filename: string): string;
var ext: string;
begin
  ext := ExtractFileExt(Filename);
  Result := 'image/jpeg';
  if ext = 'gif' then
    Result := 'image/gif';
  if ext = 'bmp' then
    Result := 'image/bmp';
  if (ext = 'jpg') or (ext = 'jpeg') then
    Result := 'image/jpeg';
  if ext = 'png' then
    Result := 'image/png';
  if ext = 'webp' then
    Result := 'image/webp';
end;

function FSize(fl: string): integer;
var PicFile: cardinal;
begin
  PicFile := FileOpen(fl, fmOpenRead);
  Result := GetFileSize(PicFile, nil);
  FileClose(PicFile);
end;

procedure TFormAct.CloseBtnClick(Sender: TObject);
begin
  close
end;

procedure TFormAct.FromFileClick(Sender: TObject);
begin
  hide;
  Application.ProcessMessages;
  viewpic.SendImg;
end;

procedure TFormAct.FromClipbrdClick(Sender: TObject);
var RetryCount: integer;
  success: Boolean;
begin
  RetryCount := 1;
  success := false;
  while not success do
    try
      Clipboard.Open;
      if Clipboard.HasFormat(CF_BITMAP) then
        hasimage := True
      else
        hasimage := false;
      success := True;
      Clipboard.close;
    except
      on Exception do
      begin
        Inc(RetryCount);
        if RetryCount < 3 then
          Sleep(RetryCount * 100)
        else
          break;
      end;
    end;

  if hasimage = false then
  begin
    MessageBox(0, '<27> <20><> <20><> <20><> <20><>!', 'Pic-is-Big', 0);
    exit;
  end;

  hide;
  Application.ProcessMessages;

  clipform.imgtmp.Picture.Bitmap.LoadFromClipboardFormat(CF_BITMAP, Clipboard.GetAsHandle(CF_BITMAP), 0);
  clipform.Show;
end;

procedure TFormAct.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    close;
end;

procedure TFormAct.FormShow(Sender: TObject);
var MonNum: integer;
begin
  MonNum := Screen.MonitorFromWindow(GetForegroundWindow, mdNearest).MonitorNum;
  Self.Top := Screen.Monitors[MonNum].Top + ((Screen.Monitors[MonNum].Height div 2) - (Self.Height div 2));
  Self.Left := Screen.Monitors[MonNum].Left + ((Screen.Monitors[MonNum].Width div 2) - (Self.Width div 2));
end;

end.