frame_ubase.pas

企业信息管理系统程序框架

unit frame_uBase;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, frame_SysParam, StdCtrls, Buttons, ToolWin, IniFiles,
  ComCtrls, ImgList, ExtCtrls, dcfdes, dcddes;

type
  Tframe_frmBase = class(TForm)
    il: TImageList;
    DCChangesStore1: TDCChangesStore;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DCChangesStore1LoadChanges(Sender: TObject;
      var processed: Boolean);
    procedure DCChangesStore1SaveChanges(Sender: TObject;
      var processed: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
    //transferParam: TStringHashMap; // 传送参数，用来窗体调用
    SysParam: TFrame_SysParam; //系统参数
    procedure processbtnimg;
    function DisToolBtnImg(aToolBtn: TToolButton;
      imgFile: String): integer;
  end;

var
  frame_frmBase: Tframe_frmBase;

implementation

uses frame_UtilFunc, frame_uMain;

{$R *.dfm}

procedure Tframe_frmBase.FormCreate(Sender: TObject);
// 初始化系统参数，窗体caption
var
//  iniFile : TIniFile;
  tmp : Integer;
begin
 // transferParam := TStringHashMap.Create(CaseInsensitiveTraits, 16);
  SysParam := frame_SysParam.SysParam;
  Caption := SysParam.SysName;
{
  //恢复窗体位置与大小
  iniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'FormSizeCfg.ini');
  tmp := iniFile.ReadInteger(Name, 'Top', 0);
  if tmp <> 0 then
    Top := tmp;
  tmp := iniFile.ReadInteger(Name, 'Left', 0);
  if tmp <> 0 then
    Left := tmp;
  tmp := iniFile.ReadInteger(Name, 'Width', 0);
  if tmp <> 0 then
    Width := tmp;
  tmp := iniFile.ReadInteger(Name, 'Height', 0);
  if tmp <> 0 then
    Height := tmp;
  iniFile.Free;
}
end;

procedure Tframe_frmBase.processBtnimg;
// 处理按钮图案
var
  i, ilindex: integer;
  btn: TComponent;
  imgname, imgFile: string;
  x1, y1, x2, y2: integer;
  bl: double;
  acolor: TColor;
begin
  for i := 0 to componentcount - 1 do
  begin
    btn := TbitBtn(components[i]);
    if uppercase(btn.Name) = 'BTNOK' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '确定(&O)');
    end;
    if uppercase(btn.Name) = 'BTNCANCEL' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '取消(&C)');
    end;
    if uppercase(btn.Name) = 'BTNAPPLY' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '应用(&A)');
    end;
    if uppercase(btn.Name) = 'BTNADD' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '增加(&A)');
    end;
    if uppercase(btn.Name) = 'BTNDEL' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '删除(&D)');
    end;

    if uppercase(btn.Name) = 'BTNEDIT' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '修改(&E)');
    end;
    if uppercase(btn.Name) = 'BTNSAVE' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '保存(&S)');
    end;
    if uppercase(btn.Name) = 'BTNFIND' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '查找(&F)');
    end;
    if uppercase(btn.Name) = 'BTNEXIT' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '退出(&X)');
    end;

    if uppercase(btn.Name) = 'BTNPRINT' then
    begin
      SetPropValueIncludeSub(btn, 'Caption', '打印(&P)');
    end;

    if btn is TBitBtn then
    begin
      imgname := Readcfg('Layout', btn.name, '无图片');
      imgFile := GetAppPath + 'img\' + imgname;
      if fileexists(imgFile) then
      begin
        (btn as TBitBtn).Glyph.LoadFromFile(imgFile);
      end;
    end;

    if (btn is TToolButton) then
    begin

      imgname := Readcfg('Layout', 'ico' + btn.name, '无图片');
      imgFile := GetAppPath + 'img\' + imgname;
      DisToolBtnImg((btn as Ttoolbutton),imgFile);
    end;

  end;
end;

function Tframe_frmBase.DisToolBtnImg(aToolBtn:TToolButton;imgFile: String): integer;
var
  aImg:TImage;
  bimg: TBitmap;
  x1, y1, x2, y2,ilIndex: integer;
  bl: double;
begin
  if fileexists(imgFile) then
  begin
    aimg := TImage.Create(self);
    aimg.AutoSize:=true;
    aImg.Stretch:=false;

    aImg.Picture.LoadFromFile(imgfile);
    if (aimg.Width / aimg.Height) > (il.Width / il.Height) then
    begin
      if (aimg.Width > il.Width) then
      begin
        aImg.Stretch:=true;
        aImg.AutoSize:=false;
        bl := aimg.Width / il.Width;
        aimg.Width := il.Width;
        aimg.Height := round(aimg.Height / bl);
      end;
    end;

    if (aimg.Width / aimg.Height) < (il.Width / il.Height) then
    begin
      if (aimg.height > il.height) then
      begin
        aImg.Stretch:=true;
        aImg.AutoSize:=false;

        bl := aimg.Height / il.Height;
        aimg.Height := il.Height;
        aimg.width := round(aimg.width / bl);
      end;
    end;


    bimg := TBitmap.Create;
    bimg.Width := il.Width;
    bimg.Height := il.Height;
    BIMG.Canvas.Brush.Color := AIMG.Picture.Bitmap.TransparentColor;
    BIMG.Canvas.FillRect(BIMG.Canvas.ClipRect);

    x1 := (il.Width - aimg.Width) div 2;
    y1 := (il.Height - aimg.Height) div 2;
    bimg.Canvas.CopyRect(Rect(x1, y1, x1 + aImg.Width, y1 + aImg.Height), aImg.Canvas, aimg.Canvas.ClipRect);

    ilindex := il.AddMasked(BIMG, AIMG.Picture.Bitmap.TransparentColor);
//        (BImg,CIMG);
    aToolBtn.ImageIndex := ilIndex;
    freeandnil(aimg);
    freeAndNil(bimg);
  end;
end;

procedure Tframe_frmBase.FormDestroy(Sender: TObject);
// 清除使用完的变量
begin
//  freeAndNIl(transferParam);
end;

procedure Tframe_frmBase.FormShow(Sender: TObject);
// 处理按钮图案
begin
  ProcessBtnimg;
end;


procedure Tframe_frmBase.FormClose(Sender: TObject;
  var Action: TCloseAction);
//var
//  iniFile : TIniFile;
begin
{
  //保存窗体位置与大小
  iniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'FormSizeCfg.ini');
  iniFile.WriteInteger(Name, 'Top', Top);
  iniFile.WriteInteger(Name, 'Left', Left);
  iniFile.WriteInteger(Name, 'Width', Width);
  iniFile.WriteInteger(Name, 'Height', Height);
  iniFile.Free;
}
end;

procedure Tframe_frmBase.DCChangesStore1LoadChanges(Sender: TObject;
  var processed: Boolean);
begin
  if not (findclass(sender.ClassName)=nil) then processed:=true;
end;

procedure Tframe_frmBase.DCChangesStore1SaveChanges(Sender: TObject;
  var processed: Boolean);
begin
  if not (findclass(sender.ClassName)=nil) then processed:=true;
end;

end.