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

📄 dlgtext.pas

📁 电子小说阅读器v2.68可用于阅读pdf.html等各种形式的文档
💻 PAS
字号:
{
模块名称:浏览文本的对话框

使用方法:1、Create
		  2、Execute

返回值:  1、mrOk:返回文件名
}

unit DlgText;

{$R-}

interface

uses Messages, Windows, SysUtils, Classes, Controls, StdCtrls, Graphics,
	 ExtCtrls, Dialogs, ComCtrls, Forms, CommDlg, Dlgs, UnZip32, Gb2Big5;

type
{ TOpenTextDialog }
  TOpenTextDialog = class(TOpenDialog)
  private
    FPanelText : TPanel;
    FPanelPos : Tpanel;
    FPanelCheck : TPanel;

    FMemoText : TMemo;
	FCheckBoxBig5 : TCheckBox;

  protected
	procedure DoClose; override;
	procedure DoShow; override;
	procedure DoSelectionChange; override;
	procedure CheckBoxBig5Click(Sender: TObject);

  public
	constructor Create(AOwner: TComponent); override;
	destructor Destroy; override;
	function Execute: Boolean; override;

  end;

{ TSaveTextDialog }
  TSaveTextDialog = class(TOpenTextDialog)
  public
	function Execute: Boolean; override;

  end;

var
	strPreviewText : string;
	strZipFilename : string;
	MemoZipText : TMemo;
	CheckBoxZipBig5 : TCheckBox;

procedure Set_UnZipOptions(var O: TDCL);
procedure Set_UserFunctions(var Z: TUserFunctions);

function  DllPrnt(Buffer: PChar; Size: ULONG): integer; stdcall;
function  DllPassword(P: PChar; N: Integer; M, Name: PChar): integer; stdcall;
function  DllService(CurFile: PChar; Size: ULONG): integer; stdcall;
function  DllReplace(Filename: PChar): integer; stdcall;
procedure DllMessage(UnCompSize : ULONG;
                     CompSize   : ULONG;
                     Factor     : UINT;
                     Month      : UINT;
                     Day        : UINT;
                     Year       : UINT;
                     Hour       : UINT;
                     Minute     : UINT;
                     C          : Char;
					 Filename   : PChar;
					 MethBuf    : PChar;
                     CRC        : ULONG;
					 Crypt      : Char); stdcall;

implementation

{ TOpenTextDialog }

constructor TOpenTextDialog.Create(AOwner: TComponent);
begin
  	inherited Create(AOwner);

	strPreviewText := '';

  	FPanelText := TPanel.Create(Self);
	with FPanelText do
	begin
		Name := 'TextPanel';

		with Font do
		begin
			Charset := GB2312_CHARSET;
			Color := clWindowText;
			Height := -15;
			Name := '宋体';
			Pitch := fpDefault;
			Size := 9;
			Style := [];
	   	end;

		Caption := '';
		SetBounds(204, 5, 180, 220);
		BevelInner := bvNone;
	   	BevelOuter := bvNone;
		BorderWidth := 0;
		TabOrder := 1;

		FPanelPos := TPanel.Create(Self);
		with FPanelPos do
		begin
			Name := 'PosPanel';
			Caption := '';
			Width := 5;
			BevelInner := bvNone;
			BevelOuter := bvNone;
			BorderWidth := 0;
			TabOrder := 0;
			Align := alRight;
			Parent := FPanelText;
	   	end;

		FPanelCheck := TPanel.Create(Self);
		with FPanelCheck do
		begin
			Name := 'CheckPanel';
			Caption := '';
			Height := 25;
			BevelInner := bvNone;
			BevelOuter := bvNone;
			BorderWidth := 0;
			TabOrder := 1;
			Align := alBottom;
			Parent := FPanelText;

			FCheckBoxBig5 := TCheckBox.Create(Self);
			with FCheckBoxBig5 do
			begin
				Name := 'CheckBoxBig5';
				Caption := '&BIG5码';
				SetBounds(0, 2, 100, 20);
				Taborder := 0;
				Parent := FPanelCheck;
				OnClick := CheckBoxBig5Click;
			end;
	   	end;

		FMemoText := TMemo.Create(Self);
//		FMemoText := TRichEdit.Create(Self);
	   	with FMemoText do
		begin
			Name := 'MemoText';
			Text := strPreviewText;
			Ctl3D := True;
            ReadOnly := True;
            ScrollBars := ssVertical;
            TabOrder := 2;
            Align := alClient;
            Parent := FPanelText;
		end;
  	end;
end;

destructor TOpenTextDialog.Destroy;
begin
	FMemoText.Free;

	FCheckBoxBig5.Free;
	FPanelCheck.Free;

	FPanelPos.Free;

	FPanelText.Free;

	inherited Destroy;
end;

procedure TOpenTextDialog.CheckBoxBig5Click(Sender: TObject);
begin
	if FCheckBoxBig5.Checked then
		FMemoText.Text := BIG5toGB(strPreviewText)
	else
	 	FMemoText.Text := strPreviewText;
end;

procedure TOpenTextDialog.DoSelectionChange;
var UF : TUserFunctions;
	Opt  : TDCL;

	pFile : File;  //文件指针
	charDataBuf : array [1 .. 2000] of Char;  //读文件缓冲
	nReadnum : Longint;  //实际读文件长度大小

	function ValidFile(const Filename: string): Boolean;
	begin
		Result := GetFileAttributes(PChar(Filename)) <> $FFFFFFFF;
  	end;

begin
	strPreviewText := '';
	FMemoText.Text := strPreviewText;
	FPanelText.Refresh;

	if FileExists(Filename) and ValidFile(Filename) then
		try
			if LowerCase(ExtractFileExt(Filename))='.zip' then
			begin  //预览zip文件
				if not IsExpectedUnZipDllVersion then Exit;

				strZipFilename := Filename;
				MemoZipText := FMemoText;
				CheckBoxZipBig5 := FCheckBoxBig5;

				Set_UserFunctions(UF);
				Set_UnZipOptions(Opt);

				Wiz_SingleEntryUnzip(0,    { number of file names being passed }
									 nil,  { file names to be unarchived }
									 0,    { number mes to be excluded from the unarchiving process }
									 nil,  { pointer of "file names to be excluded from processing" being  passed }
									 Opt,  { file nato a structure with the flags for setting the  various options }
									 UF);  { pointer to a structure that contains pointers to user functions }
			end
			else
			begin  //预览一般文件
				FillChar(charDataBuf[1], 2000, 0);

				AssignFile(pFile, Filename);
				FileMode := 0;
				Reset(pFile, 1);
			 	BlockRead(pFile, charDataBuf, SizeOf(charDataBuf), nReadnum);
             	CloseFile(pFile);

				strPreviewText := charDataBuf;
             	CheckBoxBig5Click(nil);
			end;
		except
			FMemoText.Text := '';
		end
	else
		FMemoText.Text := '';

	FPanelText.Refresh;

 	inherited DoSelectionChange;
end;

procedure TOpenTextDialog.DoClose;
begin
	inherited DoClose;
	{ Hide any hint windows left behind }
  	Application.HideHint;
end;

procedure TOpenTextDialog.DoShow;
var PreviewRect, StaticRect : TRect;
begin
	{ Set preview area to entire dialog }
	GetClientRect(Handle, PreviewRect);
	StaticRect := GetStaticRect;

	{ Move preview area to right of static area }
	PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
	Inc(PreviewRect.Top, 4);
	FPanelText.BoundsRect := PreviewRect;
	FPanelText.ParentWindow := Handle;
	FMemoText.Text := '';

  	inherited DoShow;
end;

function TOpenTextDialog.Execute;
begin
	FMemoText.Text := '';
	FCheckBoxBig5.Caption := '&BIG5码';

	if NewStyleControls and not (ofOldStyleDialog in Options) then
		Template := 'DLGTEMPLATE'
	else
		Template := nil;

  	Result := inherited Execute;
end;

{ TSaveTextDialog }

function TSaveTextDialog.Execute: Boolean;
begin
	FMemoText.Text := '';
	FCheckBoxBig5.Caption := '&BIG5码';

	if NewStyleControls and not (ofOldStyleDialog in Options) then
		Template := 'DLGTEMPLATE'
	else
		Template := nil;

  	Result := DoExecute(@GetSaveFilename);
end;

{ Preview zip File }
function DllPrnt(Buffer: PChar; Size: ULONG): integer;
begin
	Result := Size;
end;

function DllPassword(P: PChar; N: Integer; M, Name: PChar): integer;
begin
	Result := 1;
end;

function DllService(CurFile: PChar; Size: ULONG): integer;
begin
	Result := 0;
end;

function DllReplace(Filename: PChar): integer;
begin
	Result := 1;
end;

procedure DllMessage(UnCompSize : ULONG;
					 CompSize   : ULONG;
					 Factor     : UINT;
					 Month      : UINT;
					 Day        : UINT;
					 Year       : UINT;
					 Hour       : UINT;
					 Minute     : UINT;
					 C          : Char;
					 Filename   : PChar;
					 MethBuf    : PChar;
					 CRC        : ULONG;
					 Crypt      : Char);
var i : integer;
	s : string;
begin
	s := Filename;

	//忽略单个目录
	if s[Length(s)] = '/' then Exit;

	for i := Length(Filename) downto 1 do
		if s[i] = '/' then
		begin
			s := copy(s, i + 1, Length(s) - i);
			Break;
		end;

	strPreviewText := strPreviewText + s + #13#10;
	if CheckBoxZipBig5.Checked then
		MemoZipText.Lines.Add(BIG5toGB(s))
	else
		MemoZipText.Lines.Add(s);
end;

procedure Set_UserFunctions(var Z:TUserFunctions);
begin
	with Z do
	begin
		@Print                  := @DllPrnt;
		@Sound                  := nil;
		@Replace                := @DllReplace;
		@Password               := @DllPassword;
		@SendApplicationMessage := @DllMessage;
		@ServCallBk             := @DllService;
	end;
end;

procedure Set_UnZipOptions(var O: TDCL);
begin
	with O do
	begin
		ExtractOnlyNewer  := 0;
		SpaceToUnderscore := 0;
		PromptToOverwrite := 0;
		fQuiet            := 0;
		nCFlag            := 0;
		nTFlag            := 0;
		nVFlag            := 1;  //浏览
		nUFlag            := 0;
		nZFlag            := 0;
		nDFlag            := 1;  //带目录
		nOFlag            := 0;
		nAFlag            := 0;
		nZIFlag           := 0;
		C_flag            := 0;
		fPrivilege        := 1;
		lpszZipFN         := PChar(strZipFilename);
		lpszExtractDir    := PChar('');
	end;
end;

end.

⌨️ 快捷键说明

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