publicfuncunit.pas

Delphi最新三层源码(1.0),对delphi有帮助

/////////////////////////////////////////////////////////////////////////////
// 1.全局公共函数区
//
//
/////////////////////////////////////////////////////////////////////////////



unit PublicFuncUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Forms, Controls, Graphics,
  Dialogs, StdCtrls, Grids, DBGrids, DBCtrls, Mask, ExtCtrls, ComCtrls, Contnrs,
  QButtons, DataStructureUnit;
  

  function EncodeStr(s_str,s_key: String):String;           //加密函数
  function DecodeStr(s_str,s_key: String):String;           //解密函数
  procedure EncryptDB(sFileName: String);   //加密ACCESS数据库
  procedure UnEncryptDB(sFileName: String); //解密ACCESS数据库


  procedure SetFormAutoSize(oForm:TForm);                 //窗体自动缩放：
  procedure SetFormKeyDown(oForm:TForm; Sender: TObject; var Key: Word;
                           Shift: TShiftState);           //上下箭头键代替回车：
  function  IsAllowSetFocus(oForm:TForm):Boolean;         //控件是否允许通过回车键得到焦点：
  procedure SetFormKeyPress(oForm:TForm; var Key: Char);  //截获键消息：

implementation


function EncodeStr(s_str,s_key: String):String;
var l1,l2,p1,p2:integer; ch:byte;
begin
  l1:=Length(s_str); p1:=1;
  l2:=Length(s_key);    p2:=1;
  Result:='';
  while p1<=l1 do
  begin
    ch:=(byte(s_str[p1])-1) xor byte(s_key[p2]);
    if ch=0 then ch:=not byte(s_key[p2]);
    Result:=Result+CHAR(ch);
    inc(p1); if p2=l2 then p2:=1 else inc(p2);
  end;
end;


function DecodeStr(s_str,s_key: String):String;
var l1,l2,p1,p2:integer; ch:byte;
begin
  l1:=Length(s_str); p1:=1;
  l2:=Length(s_key);    p2:=1;
  Result:='';
  while p1<=l1 do
  begin
    ch:=byte(s_str[p1]);
    if ch=(not byte(s_key[p2])) then ch:=byte(s_key[p2])
    else ch:=ch xor byte(s_key[p2]);
    Result:=Result+CHAR(ch+1);
    inc(p1); if p2=l2 then p2:=1 else inc(p2);
  end;
end;

procedure SetFormAutoSize(oForm:TForm);
var i_nw, i_nh, i_i, i_j, i_nchgsize: integer;
    r_wbl, r_hbl: real;
begin
  i_nchgsize := 0;
  with oForm do
  begin
    i_nw := screen.Width;
    i_nh := screen.Height;
    r_wbl := i_nw/800;
    r_hbl := i_nh/600;
    width := trunc(Width*r_wbl);
    Height := trunc(Height*r_wbl);

    if i_nw = 800 then
      Exit;

    case i_nw  of
      800  : i_nchgsize := 0;
      640  : i_nchgsize := -1;
      1024 : i_nchgsize := 1;
    end;

    if i_nw >1024 then
      i_nchgsize := 2;

    for i_i:=0 to ComponentCount -1 do
    begin
      if ( (Components[i_i] is TControl) and  (not (Components[i_i] is TToolButton)) ) then
        with TControl(Components[i_i]) do
        begin
          Width := trunc(Width* r_wbl);
          Height := trunc(Height* r_hbl);
          top := trunc(top* r_hbl);
          left := trunc(left* r_wbl);
        end;

        if (Components[i_i] is TLabel)
             or (Components[i_i] is TPanel)
             or (Components[i_i] is TEdit)
             or (Components[i_i] is TDBEdit)
             or (Components[i_i] is TCustomGrid)
             or (Components[i_i] is TBitBtn)
             or (Components[i_i] is TButton)
             or (Components[i_i] is TSpeedButton) then

          with TLabel(Components[i_i]) do
          begin
            if not ((i_nchgsize <0) and (Font.Size <=10) and
               not (fsBold in Font.Style))  then
              Font.Size := Font.Size + i_nchgsize;
          end;

          if ( (Components[i_i] is TCustomGrid) or (Components[i_i] is TDBGrid) ) then
            with TDBGrid(Components[i_i]) do
            begin
                for i_j:=0 to  Columns.Count -1 do
                begin
                   Columns[i_j].Width := trunc(Columns[i_j].Width * r_wbl);
                   Columns[i_j].Font.Size := Columns[i_j].Font.Size+ i_nchgsize;
                   Columns[i_j].Title.Font.Size := Columns[i_j].Title.Font.Size+ i_nchgsize;
                end;
             end;
     end;

     oForm.SetBounds((Screen.Width -Width) div 2,
                 (Screen.Height - Height) div 2,
                 Width, Height);
     Font.Size := Font.Size + i_nchgsize;
   end;
end;


procedure SetFormKeyDown(oForm:TForm; Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i_i :Integer;
begin
  with oForm do
  begin
    Case Key of
      VK_DOWN:
        if true then SendMessage(oForm.Handle,WM_NEXTDLGCTL,0,0);
      VK_UP:
        begin
          for i_i:=0 to ComponentCount-1 do
          begin
            if (Components[i_i] is TControl) then
            begin
              if (Components[i_i] as TWinControl).TabOrder = ActiveControl.TabOrder-1 then
              begin
                (Components[i_i] as TWinControl).SetFocus;
                break;
              end;    {
              if TWinControl(Components[i_i]).TabOrder = ActiveControl.TabOrder-1 then
                TWinControl(Components[i_i]).SetFocus;
              break;  }
            end;
          end;
        end;
    end;
    
  end;
end;


function IsAllowSetFocus(oForm:TForm):Boolean;
var
  i_i : Integer;
begin
  for i_i:=1 to i_arymax do
  begin
    if oForm.ActiveControl is ary_Focus[i_i] then
    begin
      Result := true;
      break;
    end else
          Result := false;
  end;
end;


procedure  SetFormKeyPress(oForm:TForm; var Key: Char);
begin
  if Key = #13 then
  begin
    if IsAllowSetFocus(oForm) then
    begin
      Key :=#0;
      SendMessage(oForm.Handle,WM_NEXTDLGCTL,0,0);
    end;
  end;
end;

procedure EncryptDB(sFileName: String);
var
  F: TFileStream;
  hMutex: HWND;
begin
  hMutex := CreateMutex(nil, False, 'EntryCardAccess');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    if (length(sFileName)=0) or (not fileExists(sFileName)) then exit;

    F:=TFileStream.create(sFileName,fmopenwrite);
    try
      F.seek($00,soFromBeginning);
      F.Write(titlestr2,16);
    finally
      F.free;
    end;
  end;

end;

procedure  UnEncryptDB(sFileName: String);
var
  F: TFileStream;
  hMutex: HWND;
begin
  hMutex := CreateMutex(nil, False, 'EntryCardAccess');
  if GetLastError = ERROR_ALREADY_EXISTS then exit;

  if (length(sFileName)=0) or (not fileExists(sFileName)) then exit;
  F := TFileStream.create(sFileName,fmopenwrite);
  try
    F.seek($00,soFromBeginning);
    F.Write(titlestr,16);
  finally
  F.free;
  end;
end;



end.