MainForm.pas - master - Alex-Z/E-Library

MainForm.pas
529 строк16 KB
Алексей Замула
create: hel.dpr, hel.dproj, hel.dproj.local, hel.identcache, hel.res, MainForm.dfm, MainForm.pas, ZClasses.pas
19 май 2026, 12:06
19 май 2026, 12:0631d269a
unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls, Vcl.Imaging.pngimage,
  System.Actions, Vcl.ActnList, System.NetEncoding, Vcl.OleCtrls, SHDocVw, Winapi.WebView2,
  Winapi.ActiveX, Vcl.Edge, Vcl.ComCtrls, IniFiles, ZClasses;

type
  TFMain = class(TForm)
    OD: TOpenDialog;
    Panel: TPanel;
    SysPanel: TPanel;
    AppIcon: TImage;
    iExit: TImage;
    iMin: TImage;
    iMaxNorm: TImage;
    iParam: TImage;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    lRead: TLabel;
    iOpenBook: TImage;
    iAddBook: TImage;
    iOpenLibrary: TImage;
    lTitle: TLabel;
    Bevel4: TBevel;
    ViewBook: TEdgeBrowser;
    procedure FormCreate(Sender: TObject);
    procedure iExitMouseEnter(Sender: TObject);
    procedure iExitMouseLeave(Sender: TObject);
    procedure iExitMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iExitMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iExitClick(Sender: TObject);
    procedure MaxNormSize(MaxSize: Boolean);
    procedure iMaxNormClick(Sender: TObject);
    procedure iMaxNormMouseEnter(Sender: TObject);
    procedure iMaxNormMouseLeave(Sender: TObject);
    procedure iMaxNormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iMaxNormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iMinClick(Sender: TObject);
    procedure iMinMouseEnter(Sender: TObject);
    procedure iMinMouseLeave(Sender: TObject);
    procedure iMinMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iMinMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iParamClick(Sender: TObject);
    procedure iParamMouseEnter(Sender: TObject);
    procedure iParamMouseLeave(Sender: TObject);
    procedure iParamMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iParamMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ViewBookCreateWebViewCompleted(Sender: TCustomEdgeBrowser;
      AResult: HRESULT);
    procedure iOpenBookMouseEnter(Sender: TObject);
    procedure iOpenBookMouseLeave(Sender: TObject);
    procedure iOpenBookMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iOpenBookMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lTitleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lTitleMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lTitleMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iAddBookClick(Sender: TObject);
    procedure iAddBookMouseEnter(Sender: TObject);
    procedure iAddBookMouseLeave(Sender: TObject);
    procedure iAddBookMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iAddBookMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iOpenLibraryClick(Sender: TObject);
    procedure iOpenLibraryMouseEnter(Sender: TObject);
    procedure iOpenLibraryMouseLeave(Sender: TObject);
    procedure iOpenLibraryMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iOpenLibraryMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iOpenBookClick(Sender: TObject);
    procedure OpenBook(FileName: string);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    //procedure CreateParams(var Params: TCreateParams); override;
    //function DoHandleStyleMessage(var Message: TMessage): Boolean; override;
    procedure WMNCHitTest(var message: TWMNCHitTest); message WM_NCHITTEST;
  end;

var
  FMain    : TFMain;
  Config   : TIniFile;
  fLeft    : integer;
  fTop     : integer;
  fWidth   : integer;
  fHeight  : integer;
  Moving   : Boolean;
  CurX     : Integer;
  CurY     : Integer;
  MaxState : Boolean = false;
  png_close: TPngImage;
  png_max  : TPngImage;
  png_norm : TPngImage;
  png_min  : TPngImage;
  png_param: TPngImage;
  png_open : TPngImage;
  png_add  : TPngImage;
  png_lib  : TPngImage;
  bookFB2  : TBookFB2;
  ALibrary : TLibrary;

implementation

{$R *.dfm}
{
procedure TFMain.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle := Params.ExStyle or WS_EX_STATICEDGE;
  Params.Style := Params.Style or WS_SIZEBOX;
end;

function TFMain.DoHandleStyleMessage(var Message: TMessage): Boolean;
begin
  if Message.Msg=WM_NCHITTEST then begin
    Result := False;
  end else begin
    Result := inherited;
  end;
end;
}
procedure TFMain.WMNCHitTest(var message: TWMNCHitTest);
const
  EDGEDETECT = 7;
var
  deltaRect: TRect;
begin
  inherited;
  if BorderStyle = bsNone then
    with Message, deltaRect do
    begin
      Left   := XPos - BoundsRect.Left;
      Right  := BoundsRect.Right - XPos;
      Top    := YPos - BoundsRect.Top;
      Bottom := BoundsRect.Bottom - YPos;
      if (Top < EDGEDETECT) and (Left < EDGEDETECT) then
        Result := HTTOPLEFT
      else if (Top < EDGEDETECT) and (Right < EDGEDETECT) then
        Result := HTTOPRIGHT
      else if (Bottom < EDGEDETECT) and (Left < EDGEDETECT) then
        Result := HTBOTTOMLEFT
      else if (Bottom < EDGEDETECT) and (Right < EDGEDETECT) then
        Result := HTBOTTOMRIGHT
      else if (Top < EDGEDETECT) then
        Result := HTTOP
      else if (Left < EDGEDETECT) then
        Result := HTLEFT
      else if (Bottom < EDGEDETECT) then
        Result := HTBOTTOM
      else if (Right < EDGEDETECT) then
        Result := HTRIGHT;
      fLeft := FMain.Left;
      fTop := FMain.Top;
      fWidth := FMain.Width;
      fHeight := FMain.Height;
    end;
end;

procedure TFMain.lTitleMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Moving := True;
  CurX := X;
  CurY := Y;
end;

procedure TFMain.lTitleMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Moving then
  begin
    Left := Left + X - CurX;
    Top := Top + Y - CurY;
    fLeft := Left;
    fTop := Top;
  end;
end;

procedure TFMain.lTitleMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Moving := False;
end;

procedure TFMain.iExitMouseEnter(Sender: TObject);
begin
  PaintButton(iExit.Canvas, TThemeColor.clSelClose, png_close)
end;

procedure TFMain.iExitMouseLeave(Sender: TObject);
begin
  PaintButton(iExit.Canvas, SysPanel.Color, png_close)
end;

procedure TFMain.iExitMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iExit.Canvas, TThemeColor.clSelClose, png_close, true)
end;

procedure TFMain.iExitMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iExit.Canvas, TThemeColor.clSelClose, png_close)
end;

procedure TFMain.iMaxNormMouseEnter(Sender: TObject);
begin
  if MaxState then
    PaintButton(iMaxNorm.Canvas, TThemeColor.clSelBtn, png_norm)
  else
    PaintButton(iMaxNorm.Canvas, TThemeColor.clSelBtn, png_max)
end;

procedure TFMain.iMaxNormMouseLeave(Sender: TObject);
begin
  if MaxState then
    PaintButton(iMaxNorm.Canvas, SysPanel.Color, png_norm)
  else
    PaintButton(iMaxNorm.Canvas, SysPanel.Color, png_max)
end;

procedure TFMain.iMaxNormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if MaxState then
    PaintButton(iMaxNorm.Canvas, TThemeColor.clSelBtn, png_norm, true)
  else
    PaintButton(iMaxNorm.Canvas, TThemeColor.clSelBtn, png_max, true)
end;

procedure TFMain.iMaxNormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if MaxState then
    PaintButton(iMaxNorm.Canvas, TThemeColor.clSelBtn, png_norm)
  else
    PaintButton(iMaxNorm.Canvas, TThemeColor.clSelBtn, png_max)
end;

procedure TFMain.iMinMouseEnter(Sender: TObject);
begin
  PaintButton(iMin.Canvas, TThemeColor.clSelBtn, png_min)
end;

procedure TFMain.iMinMouseLeave(Sender: TObject);
begin
  PaintButton(iMin.Canvas, SysPanel.Color, png_min)
end;

procedure TFMain.iMinMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iMin.Canvas, TThemeColor.clSelBtn, png_min, true)
end;

procedure TFMain.iMinMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iMin.Canvas, TThemeColor.clSelBtn, png_min)
end;

procedure TFMain.iParamMouseEnter(Sender: TObject);
begin
  PaintButton(iParam.Canvas, TThemeColor.clSelBtn, png_param)
end;

procedure TFMain.iParamMouseLeave(Sender: TObject);
begin
  PaintButton(iParam.Canvas, SysPanel.Color, png_param)
end;

procedure TFMain.iParamMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iParam.Canvas, TThemeColor.clSelBtn, png_param, true)
end;

procedure TFMain.iParamMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iParam.Canvas, TThemeColor.clSelBtn, png_param)
end;

procedure TFMain.iOpenBookMouseEnter(Sender: TObject);
begin
  PaintButton(iOpenBook.Canvas, TThemeColor.clSelBtn, png_open)
end;

procedure TFMain.iOpenBookMouseLeave(Sender: TObject);
begin
  PaintButton(iOpenBook.Canvas, SysPanel.Color, png_open)
end;

procedure TFMain.iOpenBookMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iOpenBook.Canvas, TThemeColor.clSelBtn, png_open, true)
end;

procedure TFMain.iOpenBookMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iOpenBook.Canvas, TThemeColor.clSelBtn, png_open);

  if OD.Execute then
    OpenBook(OD.FileName);
end;

procedure TFMain.iAddBookMouseEnter(Sender: TObject);
begin
  PaintButton(iAddBook.Canvas, TThemeColor.clSelBtn, png_add);
end;

procedure TFMain.iAddBookMouseLeave(Sender: TObject);
begin
  PaintButton(iAddBook.Canvas, SysPanel.Color, png_add);
end;

procedure TFMain.iAddBookMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iAddBook.Canvas, TThemeColor.clSelBtn, png_add, true);
end;

procedure TFMain.iAddBookMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iAddBook.Canvas, TThemeColor.clSelBtn, png_add);
end;

procedure TFMain.iOpenLibraryMouseEnter(Sender: TObject);
begin
  PaintButton(iOpenLibrary.Canvas, TThemeColor.clSelBtn, png_lib);
end;

procedure TFMain.iOpenLibraryMouseLeave(Sender: TObject);
begin
  PaintButton(iOpenLibrary.Canvas, SysPanel.Color, png_lib);
end;

procedure TFMain.iOpenLibraryMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iOpenLibrary.Canvas, TThemeColor.clSelBtn, png_lib, true);
end;

procedure TFMain.iOpenLibraryMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PaintButton(iOpenLibrary.Canvas, TThemeColor.clSelBtn, png_lib);
end;

procedure TFMain.ViewBookCreateWebViewCompleted(Sender: TCustomEdgeBrowser;
  AResult: HRESULT);
begin
  //ViewBook.NavigateToString(html.Text);
  ViewBook.NavigateToString('<!DOCTYPE html><body bgcolor="#b8bba4"></body></html>');
end;

procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ALibrary.Save;

  Config := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Config.ini');
  Config.WriteBool('MAINFORM', 'MaxState', MaxState);
  Config.WriteInteger('MAINFORM', 'Left', fLeft);
  Config.WriteInteger('MAINFORM', 'Top', fTop);
  Config.WriteInteger('MAINFORM', 'Width', fWidth);
  Config.WriteInteger('MAINFORM', 'Height', fHeight);
  Config.Free;
end;

procedure TFMain.FormCreate(Sender: TObject);
begin
  Config := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Config.ini');
  MaxState := Config.ReadBool('MAINFORM', 'State', false);
  fLeft := Config.ReadInteger('MAINFORM', 'Left', 100);
  fTop := Config.ReadInteger('MAINFORM', 'Top', 100);
  fWidth := Config.ReadInteger('MAINFORM', 'Width', 1000);
  fHeight := Config.ReadInteger('MAINFORM', 'Height', 700);
  Config.Free;
  MaxNormSize(not MaxState);

  ALibrary := TLibrary.Create(ExtractFilePath(Application.ExeName) + 'Library.xml');

  Color := TThemeColor.clWorkArea;
  SysPanel.Color := TThemeColor.clSysPanel;
  lRead.Font.Color := TThemeColor.clReadText;

  png_close := Base64ToPng(TIcons.base64_close);
  png_max := Base64ToPng(TIcons.base64_max);
  png_norm := Base64ToPng(TIcons.base64_norm);
  png_min := Base64ToPng(TIcons.base64_min);
  png_param := Base64ToPng(TIcons.base64_param);
  png_open := Base64ToPng(TIcons.base64_open);
  png_add := Base64ToPng(TIcons.base64_add);
  png_lib := Base64ToPng(TIcons.base64_lib);
  PaintButton(iExit.Canvas, SysPanel.Color, png_close);
  if MaxState then
    PaintButton(iMaxNorm.Canvas, SysPanel.Color, png_norm)
  else
    PaintButton(iMaxNorm.Canvas, SysPanel.Color, png_max);
  PaintButton(iMin.Canvas, SysPanel.Color, png_min);
  PaintButton(iParam.Canvas, SysPanel.Color, png_param);
  PaintButton(iOpenBook.Canvas, SysPanel.Color, png_open);
  PaintButton(iAddBook.Canvas, SysPanel.Color, png_add);
  PaintButton(iOpenLibrary.Canvas, SysPanel.Color, png_lib);

  ViewBook.CreateWebView;
end;

procedure TFMain.iOpenBookClick(Sender: TObject);
begin
//
end;

procedure TFMain.iAddBookClick(Sender: TObject);
begin
//
end;

procedure TFMain.iOpenLibraryClick(Sender: TObject);
begin
//
end;

procedure TFMain.iParamClick(Sender: TObject);
begin
//
end;

procedure TFMain.iMinClick(Sender: TObject);
begin
  WindowState := wsMinimized;
end;

procedure TFMain.MaxNormSize(MaxSize: Boolean);
var
  WorkAreaRect: TRect;
begin
  if MaxSize then
  begin
    //���������� ��������� � ������ ����
    FMain.Left := fLeft;
    FMain.Top := fTop;
    FMain.Width := fWidth;
    FMain.Height := fHeight;
    //���������� ����������� ������ ������ ���� ������
    Panel.Margins.Left := 1;
    Panel.Margins.Top := 1;
    Panel.Margins.Right := 1;
    Panel.Margins.Bottom := 1;

    iMaxNorm.Hint := '����������';
    MaxState := false;
  end else
  begin
    //���������� ��������� � ������ ����
    fLeft := FMain.Left;
    fTop := FMain.Top;
    fWidth := FMain.Width;
    fHeight := FMain.Height;
    //������� ������ �������� ����� � ������ ���� ��� ��� ������
    WorkAreaRect := Screen.WorkAreaRect;
    FMain.Left := WorkAreaRect.Left;
    FMain.Top := WorkAreaRect.Top;
    FMain.Width := WorkAreaRect.Width;
    FMain.Height := WorkAreaRect.Height;
    //������� ����������� �������� ������ ���� ������
    Panel.Margins.Left := 0;
    Panel.Margins.Top := 0;
    Panel.Margins.Right := 0;
    Panel.Margins.Bottom := 0;

    iMaxNorm.Hint := '������������';
    MaxState := true;
  end;
end;

procedure TFMain.iMaxNormClick(Sender: TObject);
begin
  MaxNormSize(MaxState)
end;

procedure TFMain.iExitClick(Sender: TObject);
begin
  Close
end;

procedure TFMain.OpenBook(FileName: string);
var
  book_file: TBookFile;
begin
  book_file := TBookFile.Create(OD.FileName);
  if book_file.FileExt = 'fb2' then
  begin
    bookFB2 := TBookFB2.Create(book_file);
    lTitle.Alignment := taLeftJustify;
    lTitle.Caption := '�����: ' + bookFB2.Autors + #13#10 + '��������: ' + bookFB2.BookTitle;

    ViewBook.NavigateToString(bookFB2.Body);
    //ViewBook.CreateWebView;
  end;
end;

end.